From c980510a5ab79614fcbaf5f411b1273dc9a8c7ca Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Wed, 28 Aug 2019 20:36:00 +0000 Subject: 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/intrinsic.c | 54 +++++++++++++++++++++++++++++-------------------- 1 file changed, 32 insertions(+), 22 deletions(-) (limited to 'gcc/fortran/intrinsic.c') diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 1b6eeda..764e350 100644 --- 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; } } -- cgit v1.1