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 <ka...@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 <ka...@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