[PATCH] PR fortran/91551 -- ALLOCATED has one argument

[PATCH] PR fortran/91551 -- ALLOCATED has one argument

[Steve Kargl]

[-- Attachment #1: Type: text/plain, Size: 392 bytes --]

The attach patch was built and tested on i586-*-freebsd.
It includes a check for ALLOCATED with no arguments.
OK to commit?

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

-- 
Steve

[-- Attachment #2: pr91551.diff --]
[-- Type: text/x-diff, Size: 2364 bytes --]

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 274900)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -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)
 	    {
-	      gfc_error ("Array entity required at %L", &a->expr->where);
+	      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)
+	    {
+	      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;
 	}
     }
 
Index: gcc/testsuite/gfortran.dg/allocated_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocated_3.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/allocated_3.f90	(working copy)
@@ -0,0 +1,6 @@
+! { 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

Re: [PATCH] PR fortran/91551 -- ALLOCATED has one argument

[Janne Blomqvist]

On Wed, Aug 28, 2019 at 3:43 AM Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> The attach patch was built and tested on i586-*-freebsd.
> It includes a check for ALLOCATED with no arguments.
> OK to commit?

Ok.


-- 
Janne Blomqvist