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