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

gcc/fortran/ChangeLog

+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

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,26 +2661,34 @@ 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;
+	}
+
+      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);
 	}
 
       /* 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))
+      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",
-			ap->expr->symtree->n.sym->name,
-			&ap->expr->where);
+		      asym->name, &ap->expr->where);
 	  return MATCH_ERROR;
 	}
       else if (not_restricted && !gfc_check_init_expr (ap->expr))
@@ -2689,8 +2701,7 @@ check_inquiry (gfc_expr *e, int not_restricted)
 
       if (not_restricted == 0
 	  && ap->expr->expr_type == EXPR_VARIABLE
-	    && ap->expr->symtree->n.sym->attr.dummy
-	    && ap->expr->symtree->n.sym->attr.optional)
+	  && asym->attr.dummy && asym->attr.optional)
 	return MATCH_NO;
     }
 

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/associate_49.f90

+! { 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