From 0c9a8a8c1030d072d598880c07f4d6a8d9e7deed Mon Sep 17 00:00:00 2001 From: Mark Eggleston Date: Wed, 1 Apr 2020 12:50:16 +0100 Subject: [PATCH] fortran : FAIL: gfortran.dg/pr93365.f90 PR94386 Failures of pr93365.f90, pr93600_1.f90 and pr93600_2.f90. Changes made by PR94246 delete and changed code from expr.c introduced by PR93600, the deleted code. This broke the PR93600 test cases. Restoring the deleted code and leaving the changed code alone allows the cases for PR93600 and PR94246 to pass. gcc/fortran/ChangeLog: PR fortran/94386 expr.c (simplify_parameter_variable): Restore code deleted in PR94246. --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/expr.c | 33 ++++++++++++++++++++++++++------- 2 files changed, 32 insertions(+), 7 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 217eef29eba..2539e51861e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-04-01 Mark Eggleston + + PR fortran/94386 + expr.c (simplify_parameter_variable): Restore code deleted + in PR94246. + 2020-03-28 Paul Thomas PR fortran/94246 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 1106341df91..a9fa03ad153 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2057,6 +2057,18 @@ simplify_parameter_variable (gfc_expr *p, int type) } gfc_expression_rank (p); + /* Is this an inquiry? */ + bool inquiry = false; + gfc_ref* ref = p->ref; + while (ref) + { + if (ref->type == REF_INQUIRY) + break; + ref = ref->next; + } + if (ref && ref->type == REF_INQUIRY) + inquiry = ref->u.i == INQUIRY_LEN || ref->u.i == INQUIRY_KIND; + if (gfc_is_size_zero_array (p)) { if (p->expr_type == EXPR_ARRAY) @@ -2069,15 +2081,22 @@ simplify_parameter_variable (gfc_expr *p, int type) e->value.constructor = NULL; e->shape = gfc_copy_shape (p->shape, p->rank); e->where = p->where; - gfc_replace_expr (p, e); - return true; + /* If %kind and %len are not used then we're done, otherwise + drop through for simplification. */ + if (!inquiry) + { + gfc_replace_expr (p, e); + return true; + } } + else + { + e = gfc_copy_expr (p->symtree->n.sym->value); + if (e == NULL) + return false; - e = gfc_copy_expr (p->symtree->n.sym->value); - if (e == NULL) - return false; - - e->rank = p->rank; + e->rank = p->rank; + } if (e->ts.type == BT_CHARACTER && e->ts.u.cl == NULL) e->ts.u.cl = gfc_new_charlen (gfc_current_ns, p->ts.u.cl);