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

1 files changed, 45 insertions, 34 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index c6d17d6..5d3480e 100644
--- 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;
     }