1! { dg-do run }
2! Test typebound elemental functions on class arrays
3!
4module m
5  type :: t1
6    integer :: i
7  contains
8    procedure, pass :: disp => disp_t1
9  end type t1
10
11  type, extends(t1) :: t2
12    real :: r
13  contains
14    procedure, pass :: disp => disp_t2
15  end type t2
16
17contains
18  integer elemental function disp_t1 (q)
19    class(t1), intent(in) :: q
20    disp_t1 = q%i
21  end function
22
23  integer elemental function disp_t2 (q)
24    class(t2), intent(in) :: q
25    disp_t2 = int (q%r)
26  end function
27end module
28
29  use m
30  class(t1), allocatable :: x(:)
31  allocate (x(4), source = [(t1 (i), i=1,4)])
32  if (any (x%disp () .ne. [1,2,3,4])) call abort
33  if (any (x(2:3)%disp () .ne. [2,3])) call abort
34  if (any (x(4:3:-1)%disp () .ne. [4,3])) call abort
35  if (x(4)%disp () .ne. 4) call abort
36
37  deallocate (x)
38  allocate (x(4), source = [(t2 (2 * i, real (i) + 0.333), i=1,4)])
39  if (any (x%disp () .ne. [1,2,3,4])) call abort
40  if (any (x(2:3)%disp () .ne. [2,3])) call abort
41  if (any (x(4:3:-1)%disp () .ne. [4,3])) call abort
42  if (x(4)%disp () .ne. 4) call abort
43
44end
45