1! RUN: %S/test_modfile.sh %s %t %flang_fc1
2! REQUIRES: shell
3module m
4  type t1
5  contains
6    procedure, nopass :: s2
7    procedure, nopass :: s3
8    procedure :: r
9    generic :: foo => s2
10    generic :: read(formatted)=> r
11  end type
12  type, extends(t1) :: t2
13  contains
14    procedure, nopass :: s4
15    generic :: foo => s3
16    generic :: foo => s4
17  end type
18contains
19  subroutine s2(i)
20  end
21  subroutine s3(r)
22  end
23  subroutine s4(z)
24    complex :: z
25  end
26  subroutine r(dtv, unit, iotype, v_list, iostat, iomsg)
27    class(t1), intent(inout) :: dtv
28    integer, intent(in) :: unit
29    character (len=*), intent(in) :: iotype
30    integer, intent(in) :: v_list(:)
31    integer, intent(out) :: iostat
32    character (len=*), intent(inout) :: iomsg
33  end
34end
35
36!Expect: m.mod
37!module m
38!  type::t1
39!  contains
40!    procedure,nopass::s2
41!    procedure,nopass::s3
42!    procedure::r
43!    generic::foo=>s2
44!    generic::read(formatted)=>r
45!  end type
46!  type,extends(t1)::t2
47!  contains
48!    procedure,nopass::s4
49!    generic::foo=>s3
50!    generic::foo=>s4
51!  end type
52!contains
53!  subroutine s2(i)
54!    integer(4)::i
55!  end
56!  subroutine s3(r)
57!    real(4)::r
58!  end
59!  subroutine s4(z)
60!    complex(4)::z
61!  end
62!  subroutine r(dtv,unit,iotype,v_list,iostat,iomsg)
63!    class(t1),intent(inout)::dtv
64!    integer(4),intent(in)::unit
65!    character(*,1),intent(in)::iotype
66!    integer(4),intent(in)::v_list(:)
67!    integer(4),intent(out)::iostat
68!    character(*,1),intent(inout)::iomsg
69!  end
70!end
71