re PR fortran/91551 (ICE in sort_actual, at fortran/intrinsic.c:4193)

2019-08-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/91551
	* intrinsic.c (sort_actual): ALLOCATED has one argument. Check for
	no argument case.

2019-08-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/91551
	* gfortran.dg/allocated_3.f90

From-SVN: r275009

1 files changed, 32 insertions, 22 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 1b6eeda..764e350 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4190,35 +4190,45 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
 
   /* ALLOCATED has two mutually exclusive keywords, but only one
      can be present at time and neither is optional. */
-  if (strcmp (name, "allocated") == 0 && a->name)
+  if (strcmp (name, "allocated") == 0)
     {
-      if (strcmp (a->name, "scalar") == 0)
+      if (!a)
 	{
-          if (a->next)
-	    goto whoops;
-	  if (a->expr->rank != 0)
-	    {
-	      gfc_error ("Scalar entity required at %L", &a->expr->where);
-	      return false;
-	    }
-          return true;
+	  gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar "
+		     "allocatable entity", where);
+	  return false;
 	}
-      else if (strcmp (a->name, "array") == 0)
+
+      if (a->name)
 	{
-          if (a->next)
-	    goto whoops;
-	  if (a->expr->rank == 0)
+	  if (strcmp (a->name, "scalar") == 0)
+	    {
+	      if (a->next)
+		goto whoops;
+	      if (a->expr->rank != 0)
+		{
+		  gfc_error ("Scalar entity required at %L", &a->expr->where);
+		  return false;
+		}
+	      return true;
+	    }
+	  else if (strcmp (a->name, "array") == 0)
 	    {
-	      gfc_error ("Array entity required at %L", &a->expr->where);
+	      if (a->next)
+		goto whoops;
+	      if (a->expr->rank == 0)
+		{
+		  gfc_error ("Array entity required at %L", &a->expr->where);
+		  return false;
+		}
+	      return true;
+	    }
+	  else
+	    {
+	      gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
+			 a->name, name, &a->expr->where);
 	      return false;
 	    }
-          return true;
-	}
-      else
-	{
-	  gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
-		     a->name, name, &a->expr->where);
-	  return false;
 	}
     }