1! { dg-do run } 2! 3! Passing CLASS to TYPE 4! 5implicit none 6type t 7 integer :: A 8 real, allocatable :: B(:) 9end type t 10 11type, extends(t) :: t2 12 complex :: z = cmplx(3.3, 4.4) 13end type t2 14integer :: i 15class(t), allocatable :: x(:) 16 17allocate(t2 :: x(10)) 18select type(x) 19 type is(t2) 20 if (size (x) /= 10) call abort () 21 x = [(t2(a=-i, B=[1*i,2*i,3*i,4*i]), i = 1, 10)] 22 do i = 1, 10 23 if (x(i)%a /= -i .or. size (x(i)%b) /= 4 & 24 .or. any (x(i)%b /= [1*i,2*i,3*i,4*i])) then 25 call abort() 26 end if 27 if (x(i)%z /= cmplx(3.3, 4.4)) call abort() 28 end do 29 class default 30 call abort() 31end select 32 33call base(x) 34call baseExplicit(x, size(x)) 35call class(x) 36call classExplicit(x, size(x)) 37contains 38 subroutine base(y) 39 type(t) :: y(:) 40 if (size (y) /= 10) call abort () 41 do i = 1, 10 42 if (y(i)%a /= -i .or. size (y(i)%b) /= 4 & 43 .or. any (y(i)%b /= [1*i,2*i,3*i,4*i])) then 44 call abort() 45 end if 46 end do 47 end subroutine base 48 subroutine baseExplicit(v, n) 49 integer, intent(in) :: n 50 type(t) :: v(n) 51 if (size (v) /= 10) call abort () 52 do i = 1, 10 53 if (v(i)%a /= -i .or. size (v(i)%b) /= 4 & 54 .or. any (v(i)%b /= [1*i,2*i,3*i,4*i])) then 55 call abort() 56 end if 57 end do 58 end subroutine baseExplicit 59 subroutine class(z) 60 class(t), intent(in) :: z(:) 61 select type(z) 62 type is(t2) 63 if (size (z) /= 10) call abort () 64 do i = 1, 10 65 if (z(i)%a /= -i .or. size (z(i)%b) /= 4 & 66 .or. any (z(i)%b /= [1*i,2*i,3*i,4*i])) then 67 call abort() 68 end if 69 if (z(i)%z /= cmplx(3.3, 4.4)) call abort() 70 end do 71 class default 72 call abort() 73 end select 74 call base(z) 75 call baseExplicit(z, size(z)) 76 end subroutine class 77 subroutine classExplicit(u, n) 78 integer, intent(in) :: n 79 class(t), intent(in) :: u(n) 80 select type(u) 81 type is(t2) 82 if (size (u) /= 10) call abort () 83 do i = 1, 10 84 if (u(i)%a /= -i .or. size (u(i)%b) /= 4 & 85 .or. any (u(i)%b /= [1*i,2*i,3*i,4*i])) then 86 call abort() 87 end if 88 if (u(i)%z /= cmplx(3.3, 4.4)) call abort() 89 end do 90 class default 91 call abort() 92 end select 93 call base(u) 94 call baseExplicit(u, n) 95 end subroutine classExplicit 96end 97 98