backport: re PR fortran/91588 (ICE in check_inquiry, at fortran/expr.c:2673)

2019-09-21  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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 42f3a0755a63bc0577c8dc3cf220442f9a455329..97b32bb7e2543fc5e3d93041944f85fde045fd07 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2019-09-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       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  <kargl@gcc.gnu.org>
 
        PR fortran/91727

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 33a332efdffb818f7e64f0d5b4ef78f9a91b1c9c..cad0dd36a671cbaac0cd04a1708f961ca7119b61 100644 (file)
--- 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 221de2e428ce4a789ee894d51b7b4701a64e4916..d48010f89218316d85926e1a53ff3787cc016eb8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-09-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/91588
+       * gfortran.dg/associate_49.f90 : New test.
+
 2019-09-20  Eric Botcazou  <ebotcazou@adacore.com>
 
        * 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 (file)
index 0000000..1b20595
--- /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  <gscfq@t-online.de>
+!
+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