[gcc r10-10014] Fortran: extend check for array arguments and reject CLASS array elements.

[gcc r10-10014] Fortran: extend check for array arguments and reject CLASS array elements.

[Harald Anlauf]

https://gcc.gnu.org/g:95cda605a8f7e6b54c428b7d2c37b4f2ebe4a8d8

commit r10-10014-g95cda605a8f7e6b54c428b7d2c37b4f2ebe4a8d8
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Fri Jul 23 21:00:10 2021 +0200

    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.
    
    (cherry picked from commit e314cfc371d8b2405a1d81e51b90f9fb24b9061f)

Diff:
---
 gcc/fortran/check.c                    |  3 +--
 gcc/testsuite/gfortran.dg/pr101536.f90 | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ff87a0ceff8..1042f38486e 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 00000000000..b16af00d919
--- /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