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

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

	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.
	(gfc_check_assign): Remove extraneous space.

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

	PR fortran/91588
	* gfortran.dg/associate_49.f90 : New test.

From-SVN: r275800

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7b383b3a4f3dc9002d89fc8336532cc1cbce33a5..853bd32ecde6045aedf69814d84c831e22b99f6b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2019-09-17  Paul Thomas  <pault@gcc.gnu.org>
+
+       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.
+       (gfc_check_assign): Remove extraneous space.
+
 2019-09-15  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/91727

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index c6d17d6f27f39fbb08e0884ed9e53665c798b2d0..5d3480eb4a5912dcbe70041bf9d1530b2c610caa 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2610,6 +2610,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)
@@ -2619,20 +2621,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)
@@ -2657,41 +2661,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;
@@ -3683,7 +3694,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
 
       gfc_error ("BOZ literal constant near %L cannot be assigned to a "
                 "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts));
- 
+
       return false;
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 56d58cc64a2613ebf8670c2bd4e431f24031c575..de8b5a66febe632b016fc38972b7ea018e602b79 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-09-17  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91588
+       * gfortran.dg/associate_49.f90 : New test.
+
 2019-09-17  Yannick Moy  <moy@adacore.com>
 
        * gnat.dg/fixedpnt7.adb: New testcase.

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