Subversion Repositories openrisc

! { dg-do run }

! Test typebound elemental functions on class arrays

!

module m

  type :: t1

    integer :: i

  contains

    procedure, pass :: disp => disp_t1

  end type t1

  type, extends(t1) :: t2

    real :: r

  contains

    procedure, pass :: disp => disp_t2

  end type t2

contains

  integer elemental function disp_t1 (q)

    class(t1), intent(in) :: q

    disp_t1 = q%i

  end function

  integer elemental function disp_t2 (q)

    class(t2), intent(in) :: q

    disp_t2 = int (q%r)

  end function

end module

  use m

  class(t1), allocatable :: x(:)

  allocate (x(4), source = [(t1 (i), i=1,4)])

  if (any (x%disp () .ne. [1,2,3,4])) call abort

  if (any (x(2:3)%disp () .ne. [2,3])) call abort

  if (any (x(4:3:-1)%disp () .ne. [4,3])) call abort

  if (x(4)%disp () .ne. 4) call abort

  deallocate (x)

  allocate (x(4), source = [(t2 (2 * i, real (i) + 0.333), i=1,4)])

  if (any (x%disp () .ne. [1,2,3,4])) call abort

  if (any (x(2:3)%disp () .ne. [2,3])) call abort

  if (any (x(4:3:-1)%disp () .ne. [4,3])) call abort

  if (x(4)%disp () .ne. 4) call abort

end

! { dg-final { cleanup-modules "m" } }