From f118468ab665a749c16e65f53057ca1278b3ceec Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 12 Apr 2013 09:41:50 +0200 Subject: re PR fortran/56845 ([OOP] _vptr not set to declared type for CLASS + SAVE) 2013-04-12 Tobias Burnus 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-12 Tobias Burnus 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. From-SVN: r197844 --- gcc/fortran/ChangeLog | 72 +++++++++++++---------- gcc/fortran/trans-decl.c | 31 +++++++++- gcc/fortran/trans-expr.c | 18 ++++++ gcc/fortran/trans.h | 1 + gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gfortran.dg/class_allocate_14.f90 | 31 ++++++++++ gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 | 4 +- gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 | 25 ++++++++ 8 files changed, 154 insertions(+), 35 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_allocate_14.f90 create mode 100644 gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 (limited to 'gcc') 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 + + 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 - * 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 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 *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 + + 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 * 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" } } -- cgit v1.1