1! RUN: %S/test_modfile.sh %s %t %f18
2! modfile with subprograms
3
4module m1
5  type :: t
6  end type
7contains
8
9  pure subroutine s(x, y) bind(c)
10    logical x
11    intent(inout) y
12    intent(in) x
13  end subroutine
14
15  real function f1() result(x)
16    x = 1.0
17  end function
18
19  function f2(y)
20    complex y
21    f2 = 2.0
22  end function
23
24end
25
26module m2
27contains
28  type(t) function f3(x)
29    use m1
30    integer, parameter :: a = 2
31    type t2(b)
32      integer, kind :: b = a
33      integer :: y
34    end type
35    type(t2) :: x
36  end
37  function f4() result(x)
38    implicit complex(x)
39  end
40end
41
42! Module with a subroutine with alternate returns
43module m3
44contains
45  subroutine altReturn(arg1, arg2, *, *)
46    real :: arg1
47    real :: arg2
48  end subroutine
49end module m3
50
51!Expect: m1.mod
52!module m1
53!type::t
54!end type
55!contains
56!pure subroutine s(x,y) bind(c)
57!logical(4),intent(in)::x
58!real(4),intent(inout)::y
59!end
60!function f1() result(x)
61!real(4)::x
62!end
63!function f2(y)
64!complex(4)::y
65!real(4)::f2
66!end
67!end
68
69!Expect: m2.mod
70!module m2
71!contains
72!function f3(x)
73! use m1,only:t
74! type::t2(b)
75!  integer(4),kind::b=2_4
76!  integer(4)::y
77! end type
78! type(t2(b=2_4))::x
79! type(t)::f3
80!end
81!function f4() result(x)
82!complex(4)::x
83!end
84!end
85
86!Expect: m3.mod
87!module m3
88!contains
89!subroutine altreturn(arg1,arg2,*,*)
90!real(4)::arg1
91!real(4)::arg2
92!end
93!end
94