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