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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5e3d7b9e9a42a68a50ff5ae1131420e842f5ccb7..0f2efb239acd2278e4d24d1ea09818b44ce84e32 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 1b6eedaff6c3925cb1c3d4d9dabdc50d487d323d..764e350092632fa6ae4f9f3399003e7c09d7fd87 100644 (file)
--- 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;
        }
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 77fa37f75b827bc8417f6cc33b75f99bb81a9e22..bd9fe70d084c4110b7f05b1860090732fba45a80 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

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