From c980510a5ab79614fcbaf5f411b1273dc9a8c7ca Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Wed, 28 Aug 2019 20:36:00 +0000 Subject: [PATCH] re PR fortran/91551 (ICE in sort_actual, at fortran/intrinsic.c:4193) 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 From-SVN: r275009 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/intrinsic.c | 62 +++++++++++++---------- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/allocated_3.f90 | 6 +++ 4 files changed, 53 insertions(+), 26 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocated_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5e3d7b9e9a4..0f2efb239ac 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +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/91565 diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 1b6eedaff6c..764e3500926 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4190,36 +4190,46 @@ 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; - } - 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); + gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar " + "allocatable entity", where); return false; } + + if (a->name) + { + 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) + { + 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; + } + } } for (;;) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 77fa37f75b8..bd9fe70d084 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-08-28 Steven G. Kargl + + PR fortran/91551 + * gfortran.dg/allocated_3.f90 + 2019-08-28 Marek Polacek 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 index 00000000000..66748d6142f --- /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