From e314cfc371d8b2405a1d81e51b90f9fb24b9061f Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 23 Jul 2021 21:00:10 +0200
Subject: [PATCH] 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.
---
 gcc/fortran/check.c                    |  3 +--
 gcc/testsuite/gfortran.dg/pr101536.f90 | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr101536.f90

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
-- 
2.7.4