From: Tobias Burnus Date: Fri, 12 Apr 2013 07:41:50 +0000 (+0200) Subject: re PR fortran/56845 ([OOP] _vptr not set to declared type for CLASS + SAVE) X-Git-Tag: releases/gcc-4.9.0~6482 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=f118468ab665a749c16e65f53057ca1278b3ceec;p=thirdparty%2Fgcc.git 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e6ec4f4bd16f..d3c8b58dd5ac 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 fafde89f37ba..779df164731a 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 454755bddb7a..de851a26c03e 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -96,6 +96,24 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) #define VTABLE_FINAL_FIELD 5 +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) { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 03adfddc5439..ad6a1053a423 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 ec11002256a6..bbf27e6bb232 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 000000000000..0c7aeb432d31 --- /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 3aaff1e8c351..a41be79d91a3 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 000000000000..bec7ee225fe7 --- /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" } }