diff options
author | Steven G. Kargl <kargl@gcc.gnu.org> | 2019-08-06 19:46:29 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2019-08-06 19:46:29 +0000 |
commit | 1a3920654f92b83a206d62f4eddcf1f5c28a91de (patch) | |
tree | 5a71336fde8be9945c021f6e582690bee6cf0ebd | |
parent | ffc500dd41fd49db8e5ec5022389b664a1a04e6d (diff) | |
download | gcc-1a3920654f92b83a206d62f4eddcf1f5c28a91de.zip gcc-1a3920654f92b83a206d62f4eddcf1f5c28a91de.tar.gz gcc-1a3920654f92b83a206d62f4eddcf1f5c28a91de.tar.bz2 |
re PR fortran/42546 (ALLOCATED statement typo in the docs and for scalar variables)
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.
From-SVN: r274147
-rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/fortran/check.c | 4 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 35 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/allocated_1.f90 | 24 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/allocated_2.f90 | 16 |
6 files changed, 91 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9835cbb..b88437a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2019-08-06 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-05 Steven g. Kargl <kargl@gcc.gnu.org> PR fortran/91372 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 0204961..370a3c8 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1340,6 +1340,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) { diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index c21fbdd..d0f7c10 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4b40a31..af5349a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-08-06 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/42546 + * gfortran.dg/allocated_1.f90: New test. + * gfortran.dg/allocated_2.f90: Ditto. + 2019-08-06 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> * gcc.target/i386/avx512vp2intersect-2intersect-1b.c (AVX512F): diff --git a/gcc/testsuite/gfortran.dg/allocated_1.f90 b/gcc/testsuite/gfortran.dg/allocated_1.f90 new file mode 100644 index 0000000..43260c2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocated_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/allocated_2.f90 b/gcc/testsuite/gfortran.dg/allocated_2.f90 new file mode 100644 index 0000000..0ea186a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocated_2.f90 @@ -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 |