Message ID | 5161B4E2.1030206@net-b.de |
---|---|
State | New |
Headers | show |
* PING * Tobias Burnus: > An unallocated polymorphic variable has the declared type; however, > for static (SAVE) variables, the current code didn't set the value. > > (That the end of scope deallocation/_gfortran_caf_deregister is gone > for coarrays (declared in the main program) was a side effect. The > sync/deregistering will still happen via the _gfortran_caf_finalize > call. But that's fine and in the line of the Fortran standard; in > fact, due to the FINAL handling, the automatic deallocation of the > main program will be also removed for nonpolymorphic allocatables.) > > Build and regtested on x86-64-gnu-linux. > OK for the trunk? > > Tobias
Hi Tobias, > An unallocated polymorphic variable has the declared type; however, for > static (SAVE) variables, the current code didn't set the value. > > (That the end of scope deallocation/_gfortran_caf_deregister is gone for > coarrays (declared in the main program) was a side effect. The > sync/deregistering will still happen via the _gfortran_caf_finalize call. > But that's fine and in the line of the Fortran standard; in fact, due to the > FINAL handling, the automatic deallocation of the main program will be also > removed for nonpolymorphic allocatables.) > > Build and regtested on x86-64-gnu-linux. > OK for the trunk? Looks basically alright. Just one minor nit: + if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl) + && CLASS_DATA (sym)->attr.allocatable) I'd find it somewhat clearer to check for "sym->attr.save" instead of "TREE_STATIC (sym->backend_decl)", but that may be a matter of taste. Oh, and can you remind me why this does not need to be done for pointers? Cheers, Janus
Am 12.04.2013 00:05, schrieb Janus Weil: > Just one minor nit: > > + if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl) > + && CLASS_DATA (sym)->attr.allocatable) > > I'd find it somewhat clearer to check for "sym->attr.save" instead of > "TREE_STATIC (sym->backend_decl)", but that may be a matter of taste. I think there was a test-suite failure when I tried it. In any case, variables might be in static memory even if attr.save is not set: - Module variables - Variables of the main program - Local variables of constant size (instead of allocating them on the stack), depending on their size - All local variables with -fno-automatic, which implies SAVE - If "SAVE" has been specified for the scoping unit (For the first three items, a static initialization is not required, it could also be done after the declaration.) Instead of taking care of all those, I think it is simpler to use TREE_STATIC ;-) > Oh, and can you remind me why this does not need to be done for pointers? They are in undefined state. Thus, they need to be nullified, pointer associated or allocated before they can be used. All those actions will set both the data and the vptr component. With the new array descriptor, one actually should (could?) set some elements, e.g. attribute = pointer, version = 1, and (at least for non-CLASS) "type = ...". Then, one does not touch those components for ptr-assoc/allocate. OK as is? Tobias
2013/4/12 Tobias Burnus <burnus@net-b.de>: > Am 12.04.2013 00:05, schrieb Janus Weil: > >> Just one minor nit: >> >> + if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl) >> + && CLASS_DATA (sym)->attr.allocatable) >> >> I'd find it somewhat clearer to check for "sym->attr.save" instead of >> "TREE_STATIC (sym->backend_decl)", but that may be a matter of taste. > > I think there was a test-suite failure when I tried it. In any case, > variables might be in static memory even if attr.save is not set: > > - Module variables > - Variables of the main program > - Local variables of constant size (instead of allocating them on the > stack), depending on their size > - All local variables with -fno-automatic, which implies SAVE > - If "SAVE" has been specified for the scoping unit Yes, but for most of them one should have attr.save=SAVE_IMPLICIT (at least for #1, #4 and #5?). And for those that do not have attr.save set, gfc_trans_deferred_vars should take care of initializing the vptr already, right? Do we have a double initlialization for these cases now? > (For the first three items, a static initialization is not required, it > could also be done after the declaration.) Instead of taking care of all > those, I think it is simpler to use TREE_STATIC ;-) > > >> Oh, and can you remind me why this does not need to be done for pointers? > > They are in undefined state. Thus, they need to be nullified, pointer > associated or allocated before they can be used. All those actions will set > both the data and the vptr component. Ok, I guess one could argue that it could not hurt to do the initialization for pointers, too. But since the standard does not seems to require it, let's forget about it. > OK as is? Yes, after answering the double-initialization question above ;) Thanks for the patch ... Cheers, Janus
2013-04-07 Tobias Burnus <burnus@net-b.de> PR fortran/56845 * trans-decl.c (gfc_trans_deferred_vars): Set _vptr for allocatable static BT_CLASS. * trans-expr.c (gfc_class_set_static_fields): New function. * trans.h (gfc_class_set_static_fields): New prototype. 2013-04-07 Tobias Burnus <burnus@net-b.de> PR fortran/56845 * gfortran.dg/class_allocate_14.f90: New. * gfortran.dg/coarray_lib_alloc_2.f90: Update scan-tree-dump-times. * gfortran.dg/coarray_lib_alloc_3.f90: New. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index fafde89..779df16 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3649,7 +3649,36 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) NULL_TREE); } - if (sym->attr.dimension || sym->attr.codimension) + if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl) + && CLASS_DATA (sym)->attr.allocatable) + { + tree vptr; + + if (UNLIMITED_POLY (sym)) + vptr = null_pointer_node; + else + { + gfc_symbol *vsym; + vsym = gfc_find_derived_vtab (sym->ts.u.derived); + vptr = gfc_get_symbol_decl (vsym); + vptr = gfc_build_addr_expr (NULL, vptr); + } + + if (CLASS_DATA (sym)->attr.dimension + || (CLASS_DATA (sym)->attr.codimension + && gfc_option.coarray != GFC_FCOARRAY_LIB)) + { + tmp = gfc_class_data_get (sym->backend_decl); + tmp = gfc_build_null_descriptor (TREE_TYPE (tmp)); + } + else + tmp = null_pointer_node; + + DECL_INITIAL (sym->backend_decl) + = gfc_class_set_static_fields (sym->backend_decl, vptr, tmp); + TREE_CONSTANT (DECL_INITIAL (sym->backend_decl)) = 1; + } + else if (sym->attr.dimension || sym->attr.codimension) { /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT. */ array_type tmp = sym->as->type; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 454755b..de851a2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -97,6 +97,24 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) tree +gfc_class_set_static_fields (tree decl, tree vptr, tree data) +{ + tree tmp; + tree field; + vec<constructor_elt, va_gc> *init = NULL; + + field = TYPE_FIELDS (TREE_TYPE (decl)); + tmp = gfc_advance_chain (field, CLASS_DATA_FIELD); + CONSTRUCTOR_APPEND_ELT (init, tmp, data); + + tmp = gfc_advance_chain (field, CLASS_VPTR_FIELD); + CONSTRUCTOR_APPEND_ELT (init, tmp, vptr); + + return build_constructor (TREE_TYPE (decl), init); +} + + +tree gfc_class_data_get (tree decl) { tree data; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 03adfdd..ad6a105 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -341,6 +341,7 @@ gfc_wrapped_block; /* Class API functions. */ tree gfc_class_data_get (tree); tree gfc_class_vptr_get (tree); +tree gfc_class_set_static_fields (tree, tree, tree); tree gfc_vtable_hash_get (tree); tree gfc_vtable_size_get (tree); tree gfc_vtable_extends_get (tree); diff --git a/gcc/testsuite/gfortran.dg/class_allocate_14.f90 b/gcc/testsuite/gfortran.dg/class_allocate_14.f90 new file mode 100644 index 0000000..0c7aeb4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_14.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/56845 +! +module m +type t +integer ::a +end type t +contains +subroutine sub + type(t), save, allocatable :: x + class(t), save,allocatable :: y + if (.not. same_type_as(x,y)) call abort() +end subroutine sub +subroutine sub2 + type(t), save, allocatable :: a(:) + class(t), save,allocatable :: b(:) + if (.not. same_type_as(a,b)) call abort() +end subroutine sub2 +end module m + +use m +call sub() +call sub2() +end + +! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.data=0B}, ._vptr=&__vtab_m_T};" 1 "original" } } +! { dg-final { scan-tree-dump-times "static struct __class_m_T_a y = {._data=0B, ._vptr=&__vtab_m_T};" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 index 3aaff1e..a41be79 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 @@ -18,6 +18,6 @@ ! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 0 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 0 "original" } } ! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 new file mode 100644 index 0000000..bec7ee2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Allocate/deallocate with libcaf. +! +! As coarray_lib_alloc_2.f90 but for a subroutine instead of the PROGRAM +! +subroutine test + type t + end type t + class(t), allocatable :: xx[:], yy(:)[:] + integer :: stat + character(len=200) :: errmsg + allocate(xx[*], stat=stat, errmsg=errmsg) + allocate(yy(2)[*], stat=stat, errmsg=errmsg) + deallocate(xx,yy,stat=stat, errmsg=errmsg) + end + +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } }