| Message ID | 20190801211139.GA88674@troutmask.apl.washington.edu |
|---|---|
| State | New |
| Headers | show |
| Series | PR fortran/42546 -- ALLOCATED has 2 mutually exclusive keywords | expand |
Ping. On Thu, Aug 01, 2019 at 02:11:39PM -0700, Steve Kargl wrote: > The attached patch fixed the issues raised in the > PR fortran/42546. Namely, ALLOCATED has two possible > keywords: ALLOCATE(ARRAY=...) or ALLOCATED(SCALAR=...) > > In Tobias' original patch (attached to the PR), he > tried to make both ARRAY and SCALAR options, then > in gfc_check_allocated() appropriate checking was > added. I started down that road, but intrinsic.c( > sort_actual) got in the way. Fortunately, the > checking for ARRAY or SCALAR can be special-cased > in sort_actual. See the patch. > > Regression tested on x86_64-*-freebsd. OK to commit? > > 2019-08-01 Steven G. Kargl <kargl@gcc.gnu.org> > > PR fortran/42546 > * check.c(gfc_check_allocated): Add comment pointing to ... > * intrinsic.c(sort_actual): ... the checking done here. > > 2019-08-01 Steven G. Kargl <kargl@gcc.gnu.org> > > PR fortran/42546 > * gfortran.dg/allocated_1.f90: New test. > * gfortran.dg/allocated_2.f90: Ditto. > > -- > Steve > Index: gcc/fortran/check.c > =================================================================== > --- gcc/fortran/check.c (revision 273950) > +++ gcc/fortran/check.c (working copy) > @@ -1168,6 +1168,10 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) > } > > > +/* Limited checking for ALLOCATED intrinsic. Additional checking > + is performed in intrinsic.c(sort_actual), because ALLOCATED > + has two mutually exclusive non-optional arguments. */ > + > bool > gfc_check_allocated (gfc_expr *array) > { > Index: gcc/fortran/intrinsic.c > =================================================================== > --- gcc/fortran/intrinsic.c (revision 273950) > +++ gcc/fortran/intrinsic.c (working copy) > @@ -4180,6 +4180,40 @@ sort_actual (const char *name, gfc_actual_arglist **ap > if (f == NULL && a == NULL) /* No arguments */ > return true; > > + /* 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 (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 (;;) > { /* Put the nonkeyword arguments in a 1:1 correspondence */ > if (f == NULL) > @@ -4199,6 +4233,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap > if (a == NULL) > goto do_sort; > > +whoops: > gfc_error ("Too many arguments in call to %qs at %L", name, where); > return false; > > Index: gcc/testsuite/gfortran.dg/allocated_1.f90 > =================================================================== > --- gcc/testsuite/gfortran.dg/allocated_1.f90 (nonexistent) > +++ gcc/testsuite/gfortran.dg/allocated_1.f90 (working copy) > @@ -0,0 +1,24 @@ > +! { dg-do run } > +program foo > + > + implicit none > + > + integer, allocatable :: x > + integer, allocatable :: a(:) > + > + logical a1, a2 > + > + a1 = allocated(scalar=x) > + if (a1 .neqv. .false.) stop 1 > + a2 = allocated(array=a) > + if (a2 .neqv. .false.) stop 2 > + > + allocate(x) > + allocate(a(2)) > + > + a1 = allocated(scalar=x) > + if (a1 .neqv. .true.) stop 3 > + a2 = allocated(array=a) > + if (a2 .neqv. .true.) stop 4 > + > +end program foo > Index: gcc/testsuite/gfortran.dg/allocated_2.f90 > =================================================================== > --- gcc/testsuite/gfortran.dg/allocated_2.f90 (nonexistent) > +++ gcc/testsuite/gfortran.dg/allocated_2.f90 (working copy) > @@ -0,0 +1,16 @@ > +! { dg-do compile } > +program foo > + > + implicit none > + > + integer, allocatable :: x > + integer, allocatable :: a(:) > + > + logical a1, a2 > + > + a1 = allocated(scalar=a) ! { dg-error "Scalar entity required" } > + a2 = allocated(array=x) ! { dg-error "Array entity required" } > + a1 = allocated(scalar=x, array=a) ! { dg-error "Too many arguments" } > + a1 = allocated(array=a, scalar=x) ! { dg-error "Too many arguments" } > + > +end program foo
Hi Steve, Who thought of that one in the standard? Uuugh! The solution looks good to commit - again as far back as you feel inclined to do. Regards Paul On Tue, 6 Aug 2019 at 19:27, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > > Ping. > > On Thu, Aug 01, 2019 at 02:11:39PM -0700, Steve Kargl wrote: > > The attached patch fixed the issues raised in the > > PR fortran/42546. Namely, ALLOCATED has two possible > > keywords: ALLOCATE(ARRAY=...) or ALLOCATED(SCALAR=...) > > > > In Tobias' original patch (attached to the PR), he > > tried to make both ARRAY and SCALAR options, then > > in gfc_check_allocated() appropriate checking was > > added. I started down that road, but intrinsic.c( > > sort_actual) got in the way. Fortunately, the > > checking for ARRAY or SCALAR can be special-cased > > in sort_actual. See the patch. > > > > Regression tested on x86_64-*-freebsd. OK to commit? > > > > 2019-08-01 Steven G. Kargl <kargl@gcc.gnu.org> > > > > PR fortran/42546 > > * check.c(gfc_check_allocated): Add comment pointing to ... > > * intrinsic.c(sort_actual): ... the checking done here. > > > > 2019-08-01 Steven G. Kargl <kargl@gcc.gnu.org> > > > > PR fortran/42546 > > * gfortran.dg/allocated_1.f90: New test. > > * gfortran.dg/allocated_2.f90: Ditto. > > > > -- > > Steve > > > Index: gcc/fortran/check.c > > =================================================================== > > --- gcc/fortran/check.c (revision 273950) > > +++ gcc/fortran/check.c (working copy) > > @@ -1168,6 +1168,10 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) > > } > > > > > > +/* Limited checking for ALLOCATED intrinsic. Additional checking > > + is performed in intrinsic.c(sort_actual), because ALLOCATED > > + has two mutually exclusive non-optional arguments. */ > > + > > bool > > gfc_check_allocated (gfc_expr *array) > > { > > Index: gcc/fortran/intrinsic.c > > =================================================================== > > --- gcc/fortran/intrinsic.c (revision 273950) > > +++ gcc/fortran/intrinsic.c (working copy) > > @@ -4180,6 +4180,40 @@ sort_actual (const char *name, gfc_actual_arglist **ap > > if (f == NULL && a == NULL) /* No arguments */ > > return true; > > > > + /* 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 (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 (;;) > > { /* Put the nonkeyword arguments in a 1:1 correspondence */ > > if (f == NULL) > > @@ -4199,6 +4233,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap > > if (a == NULL) > > goto do_sort; > > > > +whoops: > > gfc_error ("Too many arguments in call to %qs at %L", name, where); > > return false; > > > > Index: gcc/testsuite/gfortran.dg/allocated_1.f90 > > =================================================================== > > --- gcc/testsuite/gfortran.dg/allocated_1.f90 (nonexistent) > > +++ gcc/testsuite/gfortran.dg/allocated_1.f90 (working copy) > > @@ -0,0 +1,24 @@ > > +! { dg-do run } > > +program foo > > + > > + implicit none > > + > > + integer, allocatable :: x > > + integer, allocatable :: a(:) > > + > > + logical a1, a2 > > + > > + a1 = allocated(scalar=x) > > + if (a1 .neqv. .false.) stop 1 > > + a2 = allocated(array=a) > > + if (a2 .neqv. .false.) stop 2 > > + > > + allocate(x) > > + allocate(a(2)) > > + > > + a1 = allocated(scalar=x) > > + if (a1 .neqv. .true.) stop 3 > > + a2 = allocated(array=a) > > + if (a2 .neqv. .true.) stop 4 > > + > > +end program foo > > Index: gcc/testsuite/gfortran.dg/allocated_2.f90 > > =================================================================== > > --- gcc/testsuite/gfortran.dg/allocated_2.f90 (nonexistent) > > +++ gcc/testsuite/gfortran.dg/allocated_2.f90 (working copy) > > @@ -0,0 +1,16 @@ > > +! { dg-do compile } > > +program foo > > + > > + implicit none > > + > > + integer, allocatable :: x > > + integer, allocatable :: a(:) > > + > > + logical a1, a2 > > + > > + a1 = allocated(scalar=a) ! { dg-error "Scalar entity required" } > > + a2 = allocated(array=x) ! { dg-error "Array entity required" } > > + a1 = allocated(scalar=x, array=a) ! { dg-error "Too many arguments" } > > + a1 = allocated(array=a, scalar=x) ! { dg-error "Too many arguments" } > > + > > +end program foo > > > -- > Steve > 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4 > 20161221 https://www.youtube.com/watch?v=IbCHE-hONow
It looks like a backwards compatibility issue. F95, 13.14.9 ALLOCATED (ARRAY). F2003, 13.7.9 ALLOCATED (ARRAY) or ALLOCATED (SCALAR) Thanks for the quick peek.
Index: gcc/fortran/check.c =================================================================== --- gcc/fortran/check.c (revision 273950) +++ gcc/fortran/check.c (working copy) @@ -1168,6 +1168,10 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) } +/* Limited checking for ALLOCATED intrinsic. Additional checking + is performed in intrinsic.c(sort_actual), because ALLOCATED + has two mutually exclusive non-optional arguments. */ + bool gfc_check_allocated (gfc_expr *array) { Index: gcc/fortran/intrinsic.c =================================================================== --- gcc/fortran/intrinsic.c (revision 273950) +++ gcc/fortran/intrinsic.c (working copy) @@ -4180,6 +4180,40 @@ sort_actual (const char *name, gfc_actual_arglist **ap if (f == NULL && a == NULL) /* No arguments */ return true; + /* 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 (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 (;;) { /* Put the nonkeyword arguments in a 1:1 correspondence */ if (f == NULL) @@ -4199,6 +4233,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap if (a == NULL) goto do_sort; +whoops: gfc_error ("Too many arguments in call to %qs at %L", name, where); return false; Index: gcc/testsuite/gfortran.dg/allocated_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/allocated_1.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/allocated_1.f90 (working copy) @@ -0,0 +1,24 @@ +! { dg-do run } +program foo + + implicit none + + integer, allocatable :: x + integer, allocatable :: a(:) + + logical a1, a2 + + a1 = allocated(scalar=x) + if (a1 .neqv. .false.) stop 1 + a2 = allocated(array=a) + if (a2 .neqv. .false.) stop 2 + + allocate(x) + allocate(a(2)) + + a1 = allocated(scalar=x) + if (a1 .neqv. .true.) stop 3 + a2 = allocated(array=a) + if (a2 .neqv. .true.) stop 4 + +end program foo Index: gcc/testsuite/gfortran.dg/allocated_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/allocated_2.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/allocated_2.f90 (working copy) @@ -0,0 +1,16 @@ +! { dg-do compile } +program foo + + implicit none + + integer, allocatable :: x + integer, allocatable :: a(:) + + logical a1, a2 + + a1 = allocated(scalar=a) ! { dg-error "Scalar entity required" } + a2 = allocated(array=x) ! { dg-error "Array entity required" } + a1 = allocated(scalar=x, array=a) ! { dg-error "Too many arguments" } + a1 = allocated(array=a, scalar=x) ! { dg-error "Too many arguments" } + +end program foo