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