aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2021-07-23 21:00:10 +0200
committerHarald Anlauf <anlauf@gmx.de>2021-07-23 21:00:10 +0200
commite314cfc371d8b2405a1d81e51b90f9fb24b9061f (patch)
treeae1984984da4e2a388f75df3c1aef5efc8594c0a /gcc
parent8408d34570c9fe9f3d22a25a76df2a4c64f08477 (diff)
downloadgcc-e314cfc371d8b2405a1d81e51b90f9fb24b9061f.zip
gcc-e314cfc371d8b2405a1d81e51b90f9fb24b9061f.tar.gz
gcc-e314cfc371d8b2405a1d81e51b90f9fb24b9061f.tar.bz2
Fortran: extend check for array arguments and reject CLASS array elements.
gcc/fortran/ChangeLog: PR fortran/101536 * check.c (array_check): Adjust check for the case of CLASS arrays. gcc/testsuite/ChangeLog: PR fortran/101536 * gfortran.dg/pr101536.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/check.c3
-rw-r--r--gcc/testsuite/gfortran.dg/pr101536.f9033
2 files changed, 34 insertions, 2 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 27bf3a7..851af1b 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -731,12 +731,11 @@ logical_array_check (gfc_expr *array, int n)
static bool
array_check (gfc_expr *e, int n)
{
- if (e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
+ if (e->rank != 0 && e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
&& CLASS_DATA (e)->attr.dimension
&& CLASS_DATA (e)->as->rank)
{
gfc_add_class_array_ref (e);
- return true;
}
if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
diff --git a/gcc/testsuite/gfortran.dg/pr101536.f90 b/gcc/testsuite/gfortran.dg/pr101536.f90
new file mode 100644
index 0000000..b16af00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr101536.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR fortran/101536 - ICE in gfc_conv_expr_descriptor
+
+program p
+ type s
+ class(*), allocatable :: c
+ end type
+ type t
+ class(*), allocatable :: c(:)
+ end type t
+ type u
+ integer :: c(2)
+ end type
+ type(t) :: x
+ x%c = [1,2,3,4]
+! print *, size (x)
+ print *, size (x%c)
+ print *, size (x%c(1)) ! { dg-error "must be an array" }
+contains
+ integer function f(x, y, z)
+ class(t), allocatable :: x(:)
+ class(u) :: y(:)
+ class(s) :: z
+ f = size (x)
+ f = size (x(1)) ! { dg-error "must be an array" }
+ f = size (y)
+ f = size (y%c(1))
+ f = size (y(2)%c)
+ f = size (y(2)%c(1)) ! { dg-error "must be an array" }
+ f = size (z) ! { dg-error "must be an array" }
+ f = size (z% c) ! { dg-error "must be an array" }
+ end
+end