diff options
-rw-r--r-- | gcc/fortran/ChangeLog.fortran-dev | 8 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 27 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 22 |
3 files changed, 46 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog.fortran-dev b/gcc/fortran/ChangeLog.fortran-dev index 84e7fb12863..9109ddfcd87 100644 --- a/gcc/fortran/ChangeLog.fortran-dev +++ b/gcc/fortran/ChangeLog.fortran-dev @@ -1,3 +1,11 @@ +2016-20-10 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_conv_expr_descriptor): Detect class object + with an abstract declared type. Use the type of the data field + and the dynamic element length from the symbol backend_decl. + * trans-decl.c (gfc_trans_deferred_vars): Initialize the + descriptor of allocatable class arrays.. + 2016-09-10 Paul Thomas <pault@gcc.gnu.org> * trans-array.c (gfc_alloc_allocatable_for_assignment): Put diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a7d9331b58b..7706ba95423 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7017,6 +7017,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) int full; bool subref_array_target = false; bool assumed_size = false; + bool abstract_class = false; gfc_expr *arg, *ss_expr; if (se->want_coarray) @@ -7340,7 +7341,19 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) } desc = info->descriptor; - elem_type = gfc_typenode_for_spec(&expr->ts); + + /* Classes with an abstract declared type present particular problems + because they mess up the 'desc' totally and they have to be detected + to provide the dynamic type elem_len. + TODO extend this to all class expressions. */ + abstract_class = gfc_expr_attr (expr).abstract + && expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym->ts.type == BT_CLASS; + + if (abstract_class) + elem_type = gfc_typenode_for_spec(&CLASS_DATA (expr->symtree->n.sym)->ts); + else + elem_type = gfc_typenode_for_spec(&expr->ts); if (se->direct_byref && !se->byref_noassign) { @@ -7372,6 +7385,18 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* Set elem_len, version, rank, dtype and attribute. */ if (expr->ts.type == BT_CHARACTER && !is_subref_array (expr)) elem_len = size_of_string_in_bytes (expr->ts.kind, se->string_length); + else if (abstract_class) + { + tmp = expr->symtree->n.sym->backend_decl; + if (DECL_LANG_SPECIFIC (tmp) && GFC_DECL_SAVED_DESCRIPTOR (tmp)) + tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp); + + tmp = gfc_get_vptr_from_expr (tmp); + if (tmp != NULL_TREE) + elem_len = gfc_vptr_size_get (tmp); + else + elem_len = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); + } else /* TODO Set this to the size of elem_type rather than the size of the descriptor elements. */ diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 92bc0dc1e57..332cc725577 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4366,22 +4366,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_set_backend_locus (&sym->declared_at); gfc_start_block (&init); - if (!sym->attr.dummy && descriptor != NULL_TREE) + if (!sym->attr.dummy && sym->ts.type == BT_CLASS + && CLASS_DATA (sym)->as) { + tree cdesc = gfc_class_data_get (sym->backend_decl); tree type = TREE_TYPE (CLASS_DATA (sym)->backend_decl); - gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as); - gfc_conv_descriptor_elem_len_set (&init, descriptor, + gfc_conv_descriptor_elem_len_set (&init, cdesc, TYPE_SIZE_UNIT (gfc_get_element_type (type))); - gfc_conv_descriptor_version_set (&init, descriptor); - gfc_conv_descriptor_rank_set (&init, descriptor, + gfc_conv_descriptor_version_set (&init, cdesc); + gfc_conv_descriptor_rank_set (&init, cdesc, CLASS_DATA (sym)->as->rank); - tmp = gfc_conv_descriptor_dtype (descriptor); + tmp = gfc_conv_descriptor_dtype (cdesc); gfc_add_modify (&init, tmp, gfc_get_dtype (&sym->ts)); - gfc_conv_descriptor_attr_set (&init, descriptor, - CLASS_DATA (sym)->attr.allocatable - ? GFC_ATTRIBUTE_ALLOCATABLE - : GFC_ATTRIBUTE_POINTER); + gfc_conv_descriptor_attr_set (&init, cdesc, + CLASS_DATA (sym)->attr.allocatable + ? GFC_ATTRIBUTE_ALLOCATABLE + : GFC_ATTRIBUTE_POINTER); } + if (!sym->attr.pointer) { /* Nullify and automatic deallocation of allocatable |