diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2021-08-30 22:41:01 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2021-08-30 22:41:01 +0200 |
| commit | 9213ff13247739d6d335064a6b568278a872a991 (patch) | |
| tree | 6e2770f644f4229344e943fca9f2b12419f94da3 | |
| parent | 7465c2ed6f1a1dfb2bec4b18bcad5fe3210b3f4e (diff) | |
| download | gcc-9213ff13247739d6d335064a6b568278a872a991.zip gcc-9213ff13247739d6d335064a6b568278a872a991.tar.gz gcc-9213ff13247739d6d335064a6b568278a872a991.tar.bz2 | |
Fortran - correct check for constraint F2008:C628 / F2018:C932
gcc/fortran/ChangeLog:
PR fortran/101349
* resolve.c (resolve_allocate_expr): An unlimited polymorphic
argument to ALLOCATE must be ALLOCATABLE or a POINTER. Fix the
corresponding check.
gcc/testsuite/ChangeLog:
PR fortran/101349
* gfortran.dg/unlimited_polymorphic_33.f90: New test.
| -rw-r--r-- | gcc/fortran/resolve.c | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/unlimited_polymorphic_33.f90 | 18 |
2 files changed, 21 insertions, 2 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f641d0d..d7aa286 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7829,8 +7829,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) } } - /* Check for F08:C628. */ - if (allocatable == 0 && pointer == 0 && !unlimited) + /* Check for F08:C628 (F2018:C932). Each allocate-object shall be a data + pointer or an allocatable variable. */ + if (allocatable == 0 && pointer == 0) { gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER", &e->where); diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_33.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_33.f90 new file mode 100644 index 0000000..8bb8864 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_33.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! PR fortran/101349 - ICE in gfc_get_descriptor_field +! Check constraint F2008:C628 / F2018:C932 + +subroutine s(x) + class(*) :: x(:) + allocate (x, source=['abc']) ! { dg-error "must be ALLOCATABLE or a POINTER" } +end + +subroutine t(x) + class(*), allocatable :: x(:) + allocate (x, source=['abc']) +end + +subroutine u(x) + class(*), pointer :: x(:) + allocate (x, source=['abc']) +end |