OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/91551 (ICE in sort_actual, at fortran/intrinsic.c:4193)

Browse Source 
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

From-SVN: r275009
This commit is contained in:
Steven G. Kargl 2019-08-28 20:36:00 +00:00
parent 4742dbe718
commit c980510a5a
4 changed files with 53 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
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/91565

62
gcc/fortran/intrinsic.c
View File

@ -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 (;;)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-08-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91551
* gfortran.dg/allocated_3.f90
2019-08-28 Marek Polacek <polacek@redhat.com>
PR c++/91360 - Implement C++20 P1143R2: constinit.

6
gcc/testsuite/gfortran.dg/allocated_3.f90 Normal file
View File

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