1! { dg-do compile }
2!
3! Check the fix for PR70031, where the 'module' prefix had to preceed
4! 'function/subroutine' in the interface (or in the CONTAINS section.
5!
6! As reported by "Bulova" on
7! https://groups.google.com/forum/#!topic/comp.lang.fortran/hE8LkVMhghQ
8!
9module test
10  Interface
11    Module Recursive Subroutine sub1 (x)
12      Integer, Intent (InOut) :: x
13    End Subroutine sub1
14    module recursive function fcn1 (x) result(res)
15      integer, intent (inout) :: x
16      integer :: res
17    end function
18  End Interface
19end module test
20
21submodule(test) testson
22  integer :: n = 10
23contains
24  Module Procedure sub1
25    If (x < n) Then
26        x = x + 1
27        Call sub1 (x)
28    End If
29  End Procedure sub1
30  recursive module function fcn1 (x) result(res)
31    integer, intent (inout) :: x
32    integer :: res
33    res = x - 1
34    if (x > 0) then
35      x = fcn1 (res)
36    else
37      res = x
38    end if
39  end function
40end submodule testson
41
42  use test
43  integer :: x = 5
44  call sub1(x)
45  if (x .ne. 10) call abort
46  x = 10
47  if (fcn1 (x) .ne. 0) call abort
48end
49! { dg-final { cleanup-submodules "test@testson" } }
50