1! { dg-do run }
2! Test the fix for pr22146, where and elemental subroutine with
3! array actual arguments would cause an ICE in gfc_conv_function_call.
4! The module is the original test case and the rest is a basic
5! functional test of the scalarization of the function call.
6!
7! Contributed by Erik Edelmann  <erik.edelmann@iki.fi>
8!             and Paul Thomas   <pault@gcc.gnu.org>
9
10  module pr22146
11
12contains
13
14    elemental subroutine foo(a)
15      integer, intent(out) :: a
16      a = 0
17    end subroutine foo
18
19    subroutine bar()
20      integer :: a(10)
21      call foo(a)
22    end subroutine bar
23
24end module pr22146
25
26  use pr22146
27  real, dimension (2)  :: x, y
28  real :: u, v
29  x = (/1.0, 2.0/)
30  u = 42.0
31
32  call bar ()
33
34! Check the various combinations of scalar and array.
35  call foobar (x, y)
36  if (any(y.ne.-x)) STOP 1
37
38  call foobar (u, y)
39  if (any(y.ne.-42.0)) STOP 2
40
41  call foobar (u, v)
42  if (v.ne.-42.0) STOP 3
43
44  v = 2.0
45  call foobar (v, x)
46  if (any(x /= -2.0)) STOP 4
47
48! Test an expression in the INTENT(IN) argument
49  x = (/1.0, 2.0/)
50  call foobar (cos (x) + u, y)
51  if (any(abs (y + cos (x) + u) .gt. 4.0e-6)) STOP 5
52
53contains
54
55  elemental subroutine foobar (a, b)
56    real, intent(IN) :: a
57    real, intent(out) :: b
58    b = -a
59  end subroutine foobar
60end
61