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