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