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
PR fortran/91551
* intrinsic.c (sort_actual): ALLOCATED has one argument. Check for
no argument case.
2019-08-28 Steven G. Kargl
PR fortran/91551
* gfortran.dg/allocated_3.f90
--
Steve
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", >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", >expr->where);
+ if (a->next)
+ goto whoops;
+ if (a->expr->rank != 0)
+ {
+ gfc_error ("Scalar entity required at %L", >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", >expr->where);
+ return false;
+ }
+ return true;
+ }
+ else
+ {
+ gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
+ a->name, name, >expr->where);
return false;
}
- return true;
- }
- else
- {
- gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
- a->name, name, >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
