This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/91551 -- ALLOCATED has one argument
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Tue, 27 Aug 2019 17:43:08 -0700
- Subject: [PATCH] PR fortran/91551 -- ALLOCATED has one argument
- Reply-to: sgk at troutmask dot apl dot washington dot edu
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
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