diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 72 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 31 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 18 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 1 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/class_allocate_14.f90 | 31 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 | 25 |
8 files changed, 154 insertions, 35 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e6ec4f4..d3c8b58 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,37 +1,45 @@ +2013-04-12 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-11 Janne Blomqvist <jb@gcc.gnu.org> - * gfortran.h: Remove enum gfc_try, replace gfc_try with bool type. - * arith.c: Replace gfc_try with bool type. - * array.c: Likewise. - * check.c: Likewise. - * class.c: Likewise. - * cpp.c: Likewise. - * cpp.h: Likewise. - * data.c: Likewise. - * data.h: Likewise. - * decl.c: Likewise. - * error.c: Likewise. - * expr.c: Likewise. - * f95-lang.c: Likewise. - * interface.c: Likewise. - * intrinsic.c: Likewise. - * intrinsic.h: Likewise. - * io.c: Likewise. - * match.c: Likewise. - * match.h: Likewise. - * module.c: Likewise. - * openmp.c: Likewise. - * parse.c: Likewise. - * parse.h: Likewise. - * primary.c: Likewise. - * resolve.c: Likewise. - * scanner.c: Likewise. - * simplify.c: Likewise. - * symbol.c: Likewise. - * trans-intrinsic.c: Likewise. - * trans-openmp.c: Likewise. - * trans-stmt.c: Likewise. - * trans-types.c: Likewise. + * gfortran.h: Remove enum gfc_try, replace gfc_try with bool type. + * arith.c: Replace gfc_try with bool type. + * array.c: Likewise. + * check.c: Likewise. + * class.c: Likewise. + * cpp.c: Likewise. + * cpp.h: Likewise. + * data.c: Likewise. + * data.h: Likewise. + * decl.c: Likewise. + * error.c: Likewise. + * expr.c: Likewise. + * f95-lang.c: Likewise. + * interface.c: Likewise. + * intrinsic.c: Likewise. + * intrinsic.h: Likewise. + * io.c: Likewise. + * match.c: Likewise. + * match.h: Likewise. + * module.c: Likewise. + * openmp.c: Likewise. + * parse.c: Likewise. + * parse.h: Likewise. + * primary.c: Likewise. + * resolve.c: Likewise. + * scanner.c: Likewise. + * simplify.c: Likewise. + * symbol.c: Likewise. + * trans-intrinsic.c: Likewise. + * trans-openmp.c: Likewise. + * trans-stmt.c: Likewise. + * trans-types.c: Likewise. 2013-04-09 Tobias Burnus <burnus@net-b.de> 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/ChangeLog b/gcc/testsuite/ChangeLog index ec11002..bbf27e6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2013-04-12 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. + 2013-04-12 Marc Glisse <marc.glisse@inria.fr> * gcc.dg/fold-cstvecshift.c: New testcase. 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" } } |