1! { dg-do compile }
2!
3! PR fortran/38487
4! Spurious warning on pointers as elemental subroutine actual arguments
5!
6! Contributed by Harald Anlauf <anlauf@gmx.de>
7
8module gfcbug82
9  implicit none
10  type t
11    real, pointer :: q(:) =>NULL()
12    real, pointer :: r(:) =>NULL()
13  end type t
14  type (t), save :: x, y
15  real, dimension(:), pointer, save :: a => NULL(), b => NULL()
16  real, save :: c(5), d
17contains
18  elemental subroutine add (q, r)
19    real, intent (inout) :: q
20    real, intent (in)    :: r
21    q = q + r
22  end subroutine add
23
24  subroutine foo ()
25      call add (y% q, x% r)
26      call add (y% q, b   )
27      call add (a   , x% r)
28      call add (a   , b   )
29      call add (y% q, d   )
30      call add (a   , d   )
31      call add (c   , x% r)
32      call add (c   , b   )
33  end subroutine foo
34end module gfcbug82
35