1! { dg-do run }
2! PR43214 - implementation of class arrays
3!
4! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
5!
6module m
7  type t
8    real :: r = 99
9  contains
10    procedure, pass :: foo => foo
11  end type t
12contains
13  elemental subroutine foo(x, i)
14    class(t),intent(in) :: x
15    integer,intent(inout) :: i
16    i = x%r + i
17  end subroutine foo
18end module m
19
20  use m
21  type(t) :: x(3)
22  integer :: n(3) = [0,100,200]
23  call x(:)%foo(n)
24  if (any(n .ne. [99,199,299])) call abort
25end
26