diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-04-12 07:41:50 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-04-12 07:41:50 +0000 |
| commit | fb139b2151bd28dbd54a6ca676c20fed69ec8176 (patch) | |
| tree | 41fd411a215082874b62193b735de66401499a64 /gcc/fortran/trans-decl.c | |
| parent | ef4a904b7f97d94c596de8002806820e6525f823 (diff) | |
| download | gcc-fb139b2151bd28dbd54a6ca676c20fed69ec8176.tar.gz | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197844 138bc75d-0d04-0410-961f-82ee72b054a4
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 fafde89f37b..779df164731 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; |