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.
6 ! Reported by Tobias Burnus <burnus@gcc.gnu.org>
13 type, extends(t0) :: t1
19 class(t0), allocatable :: foo(:)
24 class(t0), allocatable :: foo
27 class(t), allocatable :: m
28 class(t_scalar), allocatable :: m1(:)
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)
38 if (any (bar%j .ne. [1,2,3])) call abort
44 allocate(m%foo(3), source = [(t1(n, n*10), n = 4,6)])
46 ! Then with m%foo of another dynamic type.
47 select type(bar => m%foo)
51 if (any (bar%k .ne. [40,50,60])) call abort
54 ! Try it with a selector array section.
55 select type(bar => m%foo(2:3))
59 if (any (bar%k .ne. [50,60])) call abort
62 ! Try it with a selector array element.
63 select type(bar => m%foo(2))
67 if (bar%k .ne. 50) call abort
70 ! Now try class is and a selector which is an array section of an associate name.
71 select type(bar => m%foo)
75 if (any (bar%j .ne. [4,5,6])) call abort
76 select type (foobar => bar(3:2:-1))
78 if (any (foobar%k .ne. [60,50])) call abort
82 ! Now try class is and a selector which is an array element of an associate name.
83 select type(bar => m%foo)
87 if (any (bar%j .ne. [4,5,6])) call abort
88 select type (foobar => bar(2))
90 if (foobar%k .ne. 50) call abort
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.
98 allocate(m1(n)%foo, source = t1(n*99, n*999))
101 allocate(m1(n)%foo, source = t0(n*99))
103 select type(bar => m1(3)%foo)
105 if (bar%j .ne. 297) call abort
109 select type(bar => m1(1)%foo)
113 if (bar%k .ne. 999) call abort