1! { dg-do compile }
2! { dg-options "-std=f2003" }
3! Test the patch for PR25098, where passing a variable as an
4! actual argument to a formal argument that is a procedure
5! went undiagnosed.
6!
7! Based on contribution by Joost VandeVondele  <jv244@cam.ac.uk>
8!
9integer function y()
10  y = 1
11end
12integer function z()
13  z = 1
14end
15
16module m1
17contains
18  subroutine s1(f)
19    interface
20      function f()
21        integer f
22      end function f
23    end interface
24  end subroutine s1
25  subroutine s2(x)
26    integer :: x
27  end subroutine
28end module m1
29
30  use m1
31  external y
32  interface
33   function x()
34     integer x
35   end function x
36  end interface
37
38  integer :: i, y, z
39  i=1
40  call s1(i) ! { dg-error "Expected a procedure for argument" }
41  call s1(w) ! { dg-error "used as actual argument" }
42  call s1(x) ! explicit interface
43  call s1(y) ! declared external
44  call s1(z) ! { dg-error "Expected a procedure for argument" }
45  call s2(x) ! { dg-error "Invalid procedure argument" }
46contains
47  integer function w()
48    w = 1
49  end function w
50end
51