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