1! RUN: %S/test_symbols.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Tests for "proc-interface" semantics.
4! These cases are all valid.
5
6!DEF: /module1 Module
7module module1
8 abstract interface
9  !DEF: /module1/abstract1 ABSTRACT, PUBLIC (Function) Subprogram REAL(4)
10  !DEF: /module1/abstract1/x INTENT(IN) ObjectEntity REAL(4)
11  real function abstract1(x)
12   !REF: /module1/abstract1/x
13   real, intent(in) :: x
14  end function abstract1
15 end interface
16
17 interface
18  !DEF: /module1/explicit1 EXTERNAL, PUBLIC (Function) Subprogram REAL(4)
19  !DEF: /module1/explicit1/x INTENT(IN) ObjectEntity REAL(4)
20  real function explicit1(x)
21   !REF: /module1/explicit1/x
22   real, intent(in) :: x
23  end function explicit1
24  !DEF: /module1/logical EXTERNAL, PUBLIC (Function) Subprogram INTEGER(4)
25  !DEF: /module1/logical/x INTENT(IN) ObjectEntity REAL(4)
26  integer function logical(x)
27   !REF: /module1/logical/x
28   real, intent(in) :: x
29  end function logical
30  !DEF: /module1/tan EXTERNAL, PUBLIC (Function) Subprogram CHARACTER(1_4,1)
31  !DEF: /module1/tan/x INTENT(IN) ObjectEntity REAL(4)
32  character(len=1) function tan(x)
33   !REF: /module1/tan/x
34   real, intent(in) :: x
35  end function tan
36 end interface
37
38 !DEF: /module1/derived1 PUBLIC DerivedType
39 type :: derived1
40  !REF: /module1/abstract1
41  !DEF: /module1/derived1/p1 NOPASS, POINTER (Function) ProcEntity REAL(4)
42  !DEF: /module1/nested1 PUBLIC (Function) Subprogram REAL(4)
43  procedure(abstract1), pointer, nopass :: p1 => nested1
44  !REF: /module1/explicit1
45  !DEF: /module1/derived1/p2 NOPASS, POINTER (Function) ProcEntity REAL(4)
46  !REF: /module1/nested1
47  procedure(explicit1), pointer, nopass :: p2 => nested1
48  !DEF: /module1/derived1/p3 NOPASS, POINTER (Function) ProcEntity LOGICAL(4)
49  !DEF: /module1/nested2 PUBLIC (Function) Subprogram LOGICAL(4)
50  procedure(logical), pointer, nopass :: p3 => nested2
51  !DEF: /module1/derived1/p4 NOPASS, POINTER (Function) ProcEntity LOGICAL(4)
52  !DEF: /module1/nested3 PUBLIC (Function) Subprogram LOGICAL(4)
53  procedure(logical(kind=4)), pointer, nopass :: p4 => nested3
54  !DEF: /module1/derived1/p5 NOPASS, POINTER (Function) ProcEntity COMPLEX(4)
55  !DEF: /module1/nested4 PUBLIC (Function) Subprogram COMPLEX(4)
56  procedure(complex), pointer, nopass :: p5 => nested4
57  !DEF: /module1/sin ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity
58  !DEF: /module1/derived1/p6 NOPASS, POINTER (Function) ProcEntity
59  !REF: /module1/nested1
60  procedure(sin), pointer, nopass :: p6 => nested1
61  !REF: /module1/sin
62  !DEF: /module1/derived1/p7 NOPASS, POINTER (Function) ProcEntity
63  !DEF: /module1/cos ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity
64  procedure(sin), pointer, nopass :: p7 => cos
65  !REF: /module1/tan
66  !DEF: /module1/derived1/p8 NOPASS, POINTER (Function) ProcEntity CHARACTER(1_4,1)
67  !DEF: /module1/nested5 PUBLIC (Function) Subprogram CHARACTER(1_8,1)
68  procedure(tan), pointer, nopass :: p8 => nested5
69 end type derived1
70
71contains
72
73 !REF: /module1/nested1
74 !DEF: /module1/nested1/x INTENT(IN) ObjectEntity REAL(4)
75 real function nested1(x)
76  !REF: /module1/nested1/x
77  real, intent(in) :: x
78  !DEF: /module1/nested1/nested1 ObjectEntity REAL(4)
79  !REF: /module1/nested1/x
80  nested1 = x+1.
81 end function nested1
82
83 !REF: /module1/nested2
84 !DEF: /module1/nested2/x INTENT(IN) ObjectEntity REAL(4)
85 logical function nested2(x)
86  !REF: /module1/nested2/x
87  real, intent(in) :: x
88  !DEF: /module1/nested2/nested2 ObjectEntity LOGICAL(4)
89  !REF: /module1/nested2/x
90  nested2 = x/=0
91 end function nested2
92
93 !REF: /module1/nested3
94 !DEF: /module1/nested3/x INTENT(IN) ObjectEntity REAL(4)
95 logical function nested3(x)
96  !REF: /module1/nested3/x
97  real, intent(in) :: x
98  !DEF: /module1/nested3/nested3 ObjectEntity LOGICAL(4)
99  !REF: /module1/nested3/x
100  nested3 = x>0
101 end function nested3
102
103 !REF: /module1/nested4
104 !DEF: /module1/nested4/x INTENT(IN) ObjectEntity REAL(4)
105 complex function nested4(x)
106  !REF: /module1/nested4/x
107  real, intent(in) :: x
108  !DEF: /module1/nested4/nested4 ObjectEntity COMPLEX(4)
109  !DEF: /module1/nested4/cmplx ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
110  !REF: /module1/nested4/x
111  nested4 = cmplx(x+4., 6.)
112 end function nested4
113
114 !REF: /module1/nested5
115 !DEF: /module1/nested5/x INTENT(IN) ObjectEntity REAL(4)
116 character function nested5(x)
117  !REF: /module1/nested5/x
118  real, intent(in) :: x
119  !DEF: /module1/nested5/nested5 ObjectEntity CHARACTER(1_8,1)
120  nested5 = "a"
121 end function nested5
122end module module1
123
124!DEF: /explicit1 ELEMENTAL (Function) Subprogram REAL(4)
125!DEF: /explicit1/x INTENT(IN) ObjectEntity REAL(4)
126real elemental function explicit1(x)
127 !REF: /explicit1/x
128 real, intent(in) :: x
129 !DEF: /explicit1/explicit1 ObjectEntity REAL(4)
130 !REF: /explicit1/x
131 explicit1 = -x
132end function explicit1
133
134!DEF: /logical (Function) Subprogram INTEGER(4)
135!DEF: /logical/x INTENT(IN) ObjectEntity REAL(4)
136integer function logical(x)
137 !REF: /logical/x
138 real, intent(in) :: x
139 !DEF: /logical/logical ObjectEntity INTEGER(4)
140 !REF: /logical/x
141 logical = x+3.
142end function logical
143
144!DEF: /tan (Function) Subprogram REAL(4)
145!DEF: /tan/x INTENT(IN) ObjectEntity REAL(4)
146real function tan(x)
147 !REF: /tan/x
148 real, intent(in) :: x
149 !DEF: /tan/tan ObjectEntity REAL(4)
150 !REF: /tan/x
151 tan = x+5.
152end function tan
153
154!DEF: /main MainProgram
155program main
156 !REF: /module1
157 use :: module1
158 !DEF: /main/derived1 Use
159 !DEF: /main/instance ObjectEntity TYPE(derived1)
160 type(derived1) :: instance
161 !REF: /main/instance
162 !REF: /module1/derived1/p1
163 if (instance%p1(1.)/=2.) print *, "p1 failed"
164 !REF: /main/instance
165 !REF: /module1/derived1/p2
166 if (instance%p2(1.)/=2.) print *, "p2 failed"
167 !REF: /main/instance
168 !REF: /module1/derived1/p3
169 if (.not.instance%p3(1.)) print *, "p3 failed"
170 !REF: /main/instance
171 !REF: /module1/derived1/p4
172 if (.not.instance%p4(1.)) print *, "p4 failed"
173 !REF: /main/instance
174 !REF: /module1/derived1/p5
175 if (instance%p5(1.)/=(5.,6.)) print *, "p5 failed"
176 !REF: /main/instance
177 !REF: /module1/derived1/p6
178 if (instance%p6(1.)/=2.) print *, "p6 failed"
179 !REF: /main/instance
180 !REF: /module1/derived1/p7
181 if (instance%p7(0.)/=1.) print *, "p7 failed"
182 !REF: /main/instance
183 !REF: /module1/derived1/p8
184 if (instance%p8(1.)/="a") print *, "p8 failed"
185end program main
186