From: Mark Eggleston Date: Mon, 23 Mar 2020 14:42:20 +0000 (+0000) Subject: fortran: ICE in gfc_match_assignment PR93600 X-Git-Tag: basepoints/gcc-11~744 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b0d84ecc55f3ea86764b119040c5ffde36cd0524;p=thirdparty%2Fgcc.git fortran: ICE in gfc_match_assignment PR93600 This patch builds on the original patch by Steve Kargl that fixed the ICE and produced an "Unclassifiable statement at (1)" error. The processing of parameter variables now correctly handles zero length arrays used with %kind and %len. A side affect is that "Unclassifiable" error now says "Assignment to constant expression at (1)". It also fixes PR93365. gcc/fortran/ChangeLog: PR fortran/93600 * expr.c (simplify_parameter_variable): Check whether the ref chain contains INQUIRY_LEN or INQUIRY_KIND and set inquiry boolean. When an empty array has been identified and a new new EXPR_ARRAY expression has been created only return that expression if inquiry is not set. This allows the new expression to drop through to be simplified into a EXPR_CONSTANT representing %kind or %len. * match.c (gfc_match_assignment): If lvalue doesn't have a symtree free both lvalue and rvalue expressions and return an error. * resolv.c (gfc_resolve_ref): Ensure that code to handle INQUIRY_LEN is only performed for arrays with deferred types. gcc/testsuite/ChangeLog: PR fortran/93365 PR fortran/93600 * gfortran.dg/pr93365.f90: New test. * gfortran.dg/pr93600_1.f90: New test. * gfortran.dg/pr93600_2.f90: New test. --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index db79f05d73f8..05915791d865 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2020-03-23 Mark Eggleston + Steven G. Kargl + + PR fortran/93600 + * expr.c (simplify_parameter_variable): Check whether the ref + chain contains INQUIRY_LEN or INQUIRY_KIND and set inquiry + boolean. When an empty array has been identified and a new + new EXPR_ARRAY expression has been created only return that + expression if inquiry is not set. This allows the new + expression to drop through to be simplified into a + EXPR_CONSTANT representing %kind or %len. + * matc.c (gfc_match_assignment): If lvalue doesn't have a + symtree free both lvalue and rvalue expressions and return + an error. + * resolv.c (gfc_resolve_ref): Ensure that code to handle + INQUIRY_LEN is only performed for arrays with deferred types. + 2020-03-18 Jakub Jelinek * class.c (generate_finalization_wrapper): Fix up duplicated word diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 79e00b4112a9..08b0a92655ad 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); @@ -2126,7 +2145,6 @@ gfc_simplify_expr (gfc_expr *p, int type) gfc_actual_arglist *ap; gfc_intrinsic_sym* isym = NULL; - if (p == NULL) return true; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 753a5f1f1a49..3a0c097325fc 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1373,6 +1373,14 @@ gfc_match_assignment (void) return m; } + if (!lvalue->symtree) + { + gfc_free_expr (lvalue); + gfc_free_expr (rvalue); + return MATCH_ERROR; + } + + gfc_set_sym_referenced (lvalue->symtree->n.sym); new_st.op = EXEC_ASSIGN; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 23b5a2b44391..2dcb261fc714 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5314,7 +5314,7 @@ gfc_resolve_ref (gfc_expr *expr) case REF_INQUIRY: /* Implement requirement in note 9.7 of F2018 that the result of the LEN inquiry be a scalar. */ - if (ref->u.i == INQUIRY_LEN && array_ref) + if (ref->u.i == INQUIRY_LEN && array_ref && expr->ts.deferred) { array_ref->u.ar.type = AR_ELEMENT; expr->rank = 0; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 558a8c622dff..3d54e64d05b6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2020-03-23 Mark Eggleston + + PR fortran/93365 + PR fortran/93600 + * gfortran.dg/pr93365.f90: New test. + * gfortran.dg/pr93600_1.f90: New test. + * gfortran.dg/pr93600_2.f90: New test. + 2020-03-23 Tobias Burnus * lib/target-supports.exp (check_effective_target_offload_gcn): diff --git a/gcc/testsuite/gfortran.dg/pr93365.f90 b/gcc/testsuite/gfortran.dg/pr93365.f90 new file mode 100644 index 000000000000..74144d6a9ee5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93365.f90 @@ -0,0 +1,15 @@ +! { dg-do run } + +program p + logical, parameter :: a(0) = .true. + real, parameter :: b(0) = 0 + complex, parameter :: c(0) = 0 + integer :: d + data d /a%kind/ + data e /b%kind/ + data f /c%kind/ + if (d .ne. kind(a)) stop 1 + if (e .ne. kind(b)) stop 2 + if (f .ne. kind(c)) stop 3 +end + diff --git a/gcc/testsuite/gfortran.dg/pr93600_1.f90 b/gcc/testsuite/gfortran.dg/pr93600_1.f90 new file mode 100644 index 000000000000..02bb76fb77cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93600_1.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } + +program p + integer, parameter :: a(0) = 0 + character(0), parameter :: b(0) = '' + a%kind = 1 ! { dg-error "Assignment to a constant expression" } + b%len = 'a' ! { dg-error "Assignment to a constant expression" } +end program + diff --git a/gcc/testsuite/gfortran.dg/pr93600_2.f90 b/gcc/testsuite/gfortran.dg/pr93600_2.f90 new file mode 100644 index 000000000000..1fb8c1b97e2d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93600_2.f90 @@ -0,0 +1,10 @@ +! { dg-do run } + +program p + integer, parameter :: a(0) = 0 + character(0), parameter :: b(0) = '' + integer :: c + if (a%kind.ne.kind(c)) stop 1 + if (b%len.ne.0) stop 2 +end program +