From: Paul Thomas Date: Sat, 21 Sep 2019 08:35:17 +0000 (+0000) Subject: backport: re PR fortran/91588 (ICE in check_inquiry, at fortran/expr.c:2673) X-Git-Tag: releases/gcc-9.3.0~608 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=698624cd2537076b9fa982bbef91f2b4f4d648de;p=thirdparty%2Fgcc.git backport: re PR fortran/91588 (ICE in check_inquiry, at fortran/expr.c:2673) 2019-09-21 Paul Thomas Backport from mainline PR fortran/91588 * expr.c (check_inquiry): Remove extended component refs by using symbol pointers. If a function argument is an associate variable with a constant target, copy the target expression in place of the argument expression. Check that the charlen is not NULL before using the string length. 2019-09-21 Paul Thomas Backport from mainline PR fortran/91588 * gfortran.dg/associate_49.f90 : New test. From-SVN: r276016 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 42f3a0755a63..97b32bb7e254 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2019-09-21 Paul Thomas + + Backport from mainline + PR fortran/91588 + * expr.c (check_inquiry): Remove extended component refs by + using symbol pointers. If a function argument is an associate + variable with a constant target, copy the target expression in + place of the argument expression. Check that the charlen is not + NULL before using the string length. + 2019-09-19 Steven G. Kargl PR fortran/91727 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 33a332efdffb..cad0dd36a671 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2603,6 +2603,8 @@ check_inquiry (gfc_expr *e, int not_restricted) int i = 0; gfc_actual_arglist *ap; + gfc_symbol *sym; + gfc_symbol *asym; if (!e->value.function.isym || !e->value.function.isym->inquiry) @@ -2612,20 +2614,22 @@ check_inquiry (gfc_expr *e, int not_restricted) if (e->symtree == NULL) return MATCH_NO; - if (e->symtree->n.sym->from_intmod) + sym = e->symtree->n.sym; + + if (sym->from_intmod) { - if (e->symtree->n.sym->from_intmod == INTMOD_ISO_FORTRAN_ENV - && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS - && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION) + if (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV + && sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS + && sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION) return MATCH_NO; - if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING - && e->symtree->n.sym->intmod_sym_id != ISOCBINDING_C_SIZEOF) + if (sym->from_intmod == INTMOD_ISO_C_BINDING + && sym->intmod_sym_id != ISOCBINDING_C_SIZEOF) return MATCH_NO; } else { - name = e->symtree->n.sym->name; + name = sym->name; functions = inquiry_func_gnu; if (gfc_option.warn_std & GFC_STD_F2003) @@ -2650,41 +2654,48 @@ check_inquiry (gfc_expr *e, int not_restricted) if (!ap->expr) continue; + asym = ap->expr->symtree ? ap->expr->symtree->n.sym : NULL; + if (ap->expr->ts.type == BT_UNKNOWN) { - if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN - && !gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns)) + if (asym && asym->ts.type == BT_UNKNOWN + && !gfc_set_default_type (asym, 0, gfc_current_ns)) return MATCH_NO; - ap->expr->ts = ap->expr->symtree->n.sym->ts; + ap->expr->ts = asym->ts; } - /* Assumed character length will not reduce to a constant expression - with LEN, as required by the standard. */ - if (i == 5 && not_restricted && ap->expr->symtree - && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER - && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL - || ap->expr->symtree->n.sym->ts.deferred)) - { - gfc_error ("Assumed or deferred character length variable %qs " - "in constant expression at %L", - ap->expr->symtree->n.sym->name, - &ap->expr->where); - return MATCH_ERROR; - } - else if (not_restricted && !gfc_check_init_expr (ap->expr)) - return MATCH_ERROR; + if (asym && asym->assoc && asym->assoc->target + && asym->assoc->target->expr_type == EXPR_CONSTANT) + { + gfc_free_expr (ap->expr); + ap->expr = gfc_copy_expr (asym->assoc->target); + } - if (not_restricted == 0 - && ap->expr->expr_type != EXPR_VARIABLE - && !check_restricted (ap->expr)) + /* Assumed character length will not reduce to a constant expression + with LEN, as required by the standard. */ + if (i == 5 && not_restricted && asym + && asym->ts.type == BT_CHARACTER + && ((asym->ts.u.cl && asym->ts.u.cl->length == NULL) + || asym->ts.deferred)) + { + gfc_error ("Assumed or deferred character length variable %qs " + "in constant expression at %L", + asym->name, &ap->expr->where); return MATCH_ERROR; + } + else if (not_restricted && !gfc_check_init_expr (ap->expr)) + return MATCH_ERROR; - if (not_restricted == 0 - && ap->expr->expr_type == EXPR_VARIABLE - && ap->expr->symtree->n.sym->attr.dummy - && ap->expr->symtree->n.sym->attr.optional) - return MATCH_NO; + if (not_restricted == 0 + && ap->expr->expr_type != EXPR_VARIABLE + && !check_restricted (ap->expr)) + return MATCH_ERROR; + + if (not_restricted == 0 + && ap->expr->expr_type == EXPR_VARIABLE + && asym->attr.dummy && asym->attr.optional) + return MATCH_NO; } return MATCH_YES; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 221de2e428ce..d48010f89218 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-09-21 Paul Thomas + + Backport from mainline + PR fortran/91588 + * gfortran.dg/associate_49.f90 : New test. + 2019-09-20 Eric Botcazou * gcc.dg/pr91269.c: New test. diff --git a/gcc/testsuite/gfortran.dg/associate_49.f90 b/gcc/testsuite/gfortran.dg/associate_49.f90 new file mode 100644 index 000000000000..1b2059505566 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_49.f90 @@ -0,0 +1,34 @@ +! { dg-do run } +! +! Test the fix for PR91588, in which the declaration of 'a' caused +! an ICE. +! +! Contributed by Gerhardt Steinmetz +! +program p + character(4), parameter :: parm = '7890' + associate (z => '1234') + block + integer(len(z)) :: a + if (kind(a) .ne. 4) stop 1 + end block + end associate + associate (z => '123') + block + integer(len(z)+1) :: a + if (kind(a) .ne. 4) stop 2 + end block + end associate + associate (z => 1_8) + block + integer(kind(z)) :: a + if (kind(a) .ne. 8) stop 3 + end block + end associate + associate (z => parm) + block + integer(len(z)) :: a + if (kind(a) .ne. 4) stop 4 + end block + end associate +end