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

2019-08-30  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-30  Steven G. Kargl  <kargl@gcc.gnu.org>

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

From-SVN: r275228

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 01ea2cddfe502427daa96f0b0c54bc4fa881b845..3a9e7d393b8c5bd8bc3abaf85af97c87c2c55158 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,10 @@
-2019-08-18  Steven G. Kargl  <kargl@gcc.gnu.org>
+2019-08-30  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-30  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/91485
        module.c (gfc_match_use): User defined operator cannot conflict with

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index d0f7c10a4380a9dbc6729a7806713c3447d6f52b..357a35052eba714f8eecf7386b8a80478f14e55d 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4182,35 +4182,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;
        }
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 40cac8f1fc3c9a548f83d274218d537317c6296f..f2cc5e6fcb77898a1fdbd96f660812904c833535 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-08-30  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/91551
+       * gfortran.dg/allocated_3.f90
+
+2019-08-30  Segher Boessenkool  <segher@kernel.crashing.org>
+
        Backport from trunk
        2019-08-23  Segher Boessenkool  <segher@kernel.crashing.org>
 

diff --git a/gcc/testsuite/gfortran.dg/allocated_3.f90 b/gcc/testsuite/gfortran.dg/allocated_3.f90
new file mode 100644 (file)
index 0000000..66748d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocated_3.f90
@@ -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