1! { dg-do run }
2! Tests fix for PR41600 and further SELECT TYPE functionality.
3!
4! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
5!
6  implicit none
7  type t0
8    integer :: j = 42
9  end type t0
10
11  type, extends(t0) :: t1
12    integer :: k = 99
13  end type t1
14
15  type t
16    integer :: i
17    class(t0), allocatable :: foo(:)
18  end type t
19
20  type t_scalar
21    integer :: i
22    class(t0), allocatable :: foo
23  end type t_scalar
24
25  type(t) :: m
26  type(t_scalar) :: m1(4)
27  integer :: n
28
29! Test the fix for PR41600 itself - first with m%foo of declared type.
30  allocate(m%foo(3), source = [(t0(n), n = 1,3)])
31  select type(bar => m%foo)
32    type is(t0)
33      if (any (bar%j .ne. [1,2,3])) STOP 1
34    type is(t1)
35      STOP 2
36  end select
37
38  deallocate(m%foo)
39  allocate(m%foo(3), source = [(t1(n, n*10), n = 4,6)])
40
41! Then with m%foo of another dynamic type.
42  select type(bar => m%foo)
43    type is(t0)
44      STOP 3
45    type is(t1)
46      if (any (bar%k .ne. [40,50,60])) STOP 4
47  end select
48
49! Try it with a selector array section.
50  select type(bar => m%foo(2:3))
51    type is(t0)
52      STOP 5
53    type is(t1)
54      if (any (bar%k .ne. [50,60])) STOP 6
55  end select
56
57! Try it with a selector array element.
58  select type(bar => m%foo(2))
59    type is(t0)
60      STOP 7
61    type is(t1)
62      if (bar%k .ne. 50) STOP 8
63  end select
64
65! Now try class is and a selector which is an array section of an associate name.
66  select type(bar => m%foo)
67    type is(t0)
68      STOP 9
69    class is (t1)
70      if (any (bar%j .ne. [4,5,6])) STOP 10
71      select type (foobar => bar(3:2:-1))
72        type is (t1)
73          if (any (foobar%k .ne. [60,50])) STOP 11
74        end select
75  end select
76
77! Now try class is and a selector which is an array element of an associate name.
78  select type(bar => m%foo)
79    type is(t0)
80      STOP 12
81    class is (t1)
82      if (any (bar%j .ne. [4,5,6])) STOP 13
83      select type (foobar => bar(2))
84        type is (t1)
85          if (foobar%k .ne. 50) STOP 14
86        end select
87  end select
88
89! Check class a component of an element of an array. Note that an array of such
90! objects cannot be allowed since the elements could have different dynamic types.
91! (F2003 C614)
92  do n = 1, 2
93    allocate(m1(n)%foo, source = t1(n*99, n*999))
94  end do
95  do n = 3, 4
96    allocate(m1(n)%foo, source = t0(n*99))
97  end do
98  select type(bar => m1(3)%foo)
99    type is(t0)
100      if (bar%j .ne. 297) STOP 15
101    type is(t1)
102      STOP 16
103  end select
104  select type(bar => m1(1)%foo)
105    type is(t0)
106      STOP 17
107    type is(t1)
108      if (bar%k .ne. 999) STOP 18
109  end select
110end
111