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

gcc/fortran/ChangeLog

 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/91565
 	* simplify.c (gfc_simplify_reshape): Add additional checks of the
 	ORDER dummy argument.

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;
 	}
     }
 

gcc/testsuite/ChangeLog

+2019-08-28  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/91551
+ 	* gfortran.dg/allocated_3.f90
+
 2019-08-28  Marek Polacek  <polacek@redhat.com>
 
 	PR c++/91360 - Implement C++20 P1143R2: constinit.

gcc/testsuite/gfortran.dg/allocated_3.f90

+! { dg-do compile }
+! PR fortran/91551
+! Contributed by Gerhard Steinmetz
+program p
+   if (allocated()) stop 1 ! { dg-error "requires an array or scalar allocatable" }
+end