From 16a51cf5491b642639b60ea12c0fff12a5403934 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 22 Apr 2019 06:50:33 +0000 Subject: re PR fortran/57284 ([OOP] ICE with find_array_spec for polymorphic arrays) 2019-04-22 Paul Thomas 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 PR fortran/57284 * gfortran.dg/class_70.f03 From-SVN: r270489 --- gcc/fortran/trans-intrinsic.c | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-intrinsic.c') 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)); } -- cgit v1.1