Subversion Repositories openrisc

! { 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) call abort ()

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

      call abort()

  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) call abort ()

      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

            call abort()

        end if

      end do

      class default

        call abort()

    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) call abort ()

      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

            call abort()

        end if

      end do

      class default

        call abort()

    end select

  end subroutine classExplicit

end