diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2013-04-12 09:41:50 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-04-12 09:41:50 +0200 |
| commit | f118468ab665a749c16e65f53057ca1278b3ceec (patch) | |
| tree | 41fd411a215082874b62193b735de66401499a64 /gcc/fortran/trans-decl.c | |
| parent | bb50698284eaaf849182f78779af4b3fde7503e1 (diff) | |
| download | gcc-f118468ab665a749c16e65f53057ca1278b3ceec.zip gcc-f118468ab665a749c16e65f53057ca1278b3ceec.tar.gz gcc-f118468ab665a749c16e65f53057ca1278b3ceec.tar.bz2 | |
re PR fortran/56845 ([OOP] _vptr not set to declared type for CLASS + SAVE)
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-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.
From-SVN: r197844
Diffstat (limited to 'gcc/fortran/trans-decl.c')
| -rw-r--r-- | gcc/fortran/trans-decl.c | 31 |
1 files changed, 30 insertions, 1 deletions
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; |