| ! { dg-do run } |
| ! |
| ! Passing TYPE to CLASS |
| ! |
| implicit none |
| type t |
| integer :: A |
| real, allocatable :: B(:) |
| end type t |
| |
| type(t), allocatable :: x(:) |
| type(t) :: y(10) |
| integer :: i |
| |
| allocate(x(10)) |
| if (size (x) /= 10) STOP 1 |
| x = [(t(a=-i, B=[1*i,2*i,3*i,4*i]), i = 1, 10)] |
| do i = 1, 10 |
| if (x(i)%a /= -i .or. size (x(i)%b) /= 4 & |
| .or. any (x(i)%b /= [1*i,2*i,3*i,4*i])) then |
| STOP 2 |
| end if |
| end do |
| |
| y = x ! TODO: Segfaults in runtime without 'y' being set |
| |
| call class(x) |
| call classExplicit(x, size(x)) |
| call class(y) |
| call classExplicit(y, size(y)) |
| |
| contains |
| subroutine class(z) |
| class(t), intent(in) :: z(:) |
| select type(z) |
| type is(t) |
| if (size (z) /= 10) STOP 3 |
| do i = 1, 10 |
| if (z(i)%a /= -i .or. size (z(i)%b) /= 4 & |
| .or. any (z(i)%b /= [1*i,2*i,3*i,4*i])) then |
| STOP 4 |
| end if |
| end do |
| class default |
| STOP 5 |
| end select |
| end subroutine class |
| subroutine classExplicit(u, n) |
| integer, intent(in) :: n |
| class(t), intent(in) :: u(n) |
| select type(u) |
| type is(t) |
| if (size (u) /= 10) STOP 6 |
| do i = 1, 10 |
| if (u(i)%a /= -i .or. size (u(i)%b) /= 4 & |
| .or. any (u(i)%b /= [1*i,2*i,3*i,4*i])) then |
| STOP 7 |
| end if |
| end do |
| class default |
| STOP 8 |
| end select |
| end subroutine classExplicit |
| end |
| |