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])) call abort
34    type is(t1)
35      call abort
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      call abort
45    type is(t1)
46      if (any (bar%k .ne. [40,50,60])) call abort
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      call abort
53    type is(t1)
54      if (any (bar%k .ne. [50,60])) call abort
55  end select
56
57! Try it with a selector array element.
58  select type(bar => m%foo(2))
59    type is(t0)
60      call abort
61    type is(t1)
62      if (bar%k .ne. 50) call abort
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      call abort
69    class is (t1)
70      if (any (bar%j .ne. [4,5,6])) call abort
71      select type (foobar => bar(3:2:-1))
72        type is (t1)
73          if (any (foobar%k .ne. [60,50])) call abort
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      call abort
81    class is (t1)
82      if (any (bar%j .ne. [4,5,6])) call abort
83      select type (foobar => bar(2))
84        type is (t1)
85          if (foobar%k .ne. 50) call abort
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) call abort
101    type is(t1)
102      call abort
103  end select
104  select type(bar => m1(1)%foo)
105    type is(t0)
106      call abort
107    type is(t1)
108      if (bar%k .ne. 999) call abort
109  end select
110end
111