1! { dg-do compile }
2!
3! PR fortran/46356
4! This program was leading to an ICE related to class arrays
5!
6! Original testcase by Ian Harvey <ian_harvey@bigpond.com>
7! Reduced by Janus Weil <Janus@gcc.gnu.org>
8
9  IMPLICIT NONE
10
11  TYPE :: ParentVector
12    INTEGER :: a
13  END TYPE ParentVector  
14
15CONTAINS       
16
17  SUBROUTINE vector_operation(pvec)     
18    CLASS(ParentVector), INTENT(INOUT) :: pvec(:)
19    print *,pvec(1)%a
20  END SUBROUTINE
21
22END
23
24