diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2019-04-22 06:50:33 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2019-04-22 06:50:33 +0000 |
| commit | 16a51cf5491b642639b60ea12c0fff12a5403934 (patch) | |
| tree | 3df2343a26f4954033b65ca19113ed070fefedfd /gcc/fortran/trans-intrinsic.c | |
| parent | 76a86e861665f8fc9595969112eb5a08590b5a29 (diff) | |
| download | gcc-16a51cf5491b642639b60ea12c0fff12a5403934.zip gcc-16a51cf5491b642639b60ea12c0fff12a5403934.tar.gz gcc-16a51cf5491b642639b60ea12c0fff12a5403934.tar.bz2 | |
re PR fortran/57284 ([OOP] ICE with find_array_spec for polymorphic arrays)
2019-04-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/57284
* resolve.c (find_array_spec): If this is a class expression
and the symbol and component array specs are the same, this is
not an error.
*trans-intrinsic.c (gfc_conv_intrinsic_size): If a class symbol
argument, has no namespace, it has come from the interface
mapping and the _data component must be accessed directly.
2019-04-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/57284
* gfortran.dg/class_70.f03
From-SVN: r270489
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 25 |
1 files changed, 23 insertions, 2 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 2eb5d1a..e0a4c67 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7446,6 +7446,8 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) tree fncall0; tree fncall1; gfc_se argse; + gfc_expr *e; + gfc_symbol *sym = NULL; gfc_init_se (&argse, NULL); actual = expr->value.function.actual; @@ -7453,12 +7455,31 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) if (actual->expr->ts.type == BT_CLASS) gfc_add_class_array_ref (actual->expr); + e = actual->expr; + + /* These are emerging from the interface mapping, when a class valued + function appears as the rhs in a realloc on assign statement, where + the size of the result is that of one of the actual arguments. */ + if (e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->ns == NULL /* This is distinctive! */ + && e->symtree->n.sym->ts.type == BT_CLASS + && e->ref && e->ref->type == REF_COMPONENT + && strcmp (e->ref->u.c.component->name, "_data") == 0) + sym = e->symtree->n.sym; + argse.data_not_needed = 1; - if (gfc_is_class_array_function (actual->expr)) + if (gfc_is_class_array_function (e)) { /* For functions that return a class array conv_expr_descriptor is not able to get the descriptor right. Therefore this special case. */ - gfc_conv_expr_reference (&argse, actual->expr); + gfc_conv_expr_reference (&argse, e); + argse.expr = gfc_build_addr_expr (NULL_TREE, + gfc_class_data_get (argse.expr)); + } + else if (sym && sym->backend_decl) + { + gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (sym->backend_decl))); + argse.expr = sym->backend_decl; argse.expr = gfc_build_addr_expr (NULL_TREE, gfc_class_data_get (argse.expr)); } |