xref: /llvm-project/flang/test/Semantics/ignore_tkr01.f90 (revision d6f314ce870266a051a659d09938d8ceb34e36f1) 
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2! !DIR$ IGNORE_TKR tests
3
4!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
5!dir$ ignore_tkr
6
7module m
8
9!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
10!dir$ ignore_tkr
11
12  interface
13    subroutine t1(x)
14!dir$ ignore_tkr
15      real, intent(in) :: x
16    end
17
18    subroutine t2(x)
19!dir$ ignore_tkr(t) x
20      real, intent(in) :: x
21    end
22
23    subroutine t3(x)
24!dir$ ignore_tkr(k) x
25      real, intent(in) :: x
26    end
27
28    subroutine t4(a)
29!dir$ ignore_tkr(r) a
30      real, intent(in) :: a(2)
31    end
32
33    subroutine t5(m)
34!dir$ ignore_tkr(r) m
35      real, intent(in) :: m(2,2)
36    end
37
38    subroutine t6(x)
39!dir$ ignore_tkr(a) x
40      real, intent(in) :: x
41    end
42
43    subroutine t7(x)
44!ERROR: !DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters
45!dir$ ignore_tkr() x
46      real, intent(in) :: x
47    end
48
49    subroutine t8(x)
50!dir$ ignore_tkr x
51      real, intent(in) :: x
52    end
53
54    subroutine t9(x)
55!dir$ ignore_tkr x
56!WARNING: !DIR$ IGNORE_TKR should not apply to an allocatable or pointer
57      real, intent(in), allocatable :: x
58    end
59
60    subroutine t10(x)
61!dir$ ignore_tkr x
62!WARNING: !DIR$ IGNORE_TKR should not apply to an allocatable or pointer
63      real, intent(in), pointer :: x
64    end
65
66    subroutine t11
67!dir$ ignore_tkr x
68!ERROR: !DIR$ IGNORE_TKR directive may apply only to a dummy data argument
69      real :: x
70    end
71
72    subroutine t12(p,q,r)
73!dir$ ignore_tkr p, q
74!ERROR: 'p' is a data object and may not be EXTERNAL
75      real, external :: p
76!ERROR: 'q' is already declared as an object
77      procedure(real) :: q
78      procedure(), pointer :: r
79!ERROR: 'r' must be an object
80!dir$ ignore_tkr r
81    end
82
83    elemental subroutine t13(x)
84!dir$ ignore_tkr(r) x
85!ERROR: !DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure
86      real, intent(in) :: x
87    end
88
89    subroutine t14(x)
90!dir$ ignore_tkr(r) x
91!WARNING: !DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor
92      real x(:)
93    end
94
95    module subroutine t24(x)
96!dir$ ignore_tkr(t) x
97      real x(:)
98    end
99
100  end interface
101
102 contains
103    subroutine t15(x)
104!dir$ ignore_tkr x
105!ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
106      real, intent(in), allocatable :: x
107    end
108
109    subroutine t16(x)
110!dir$ ignore_tkr x
111!ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
112      real, intent(in), pointer :: x
113    end
114
115  subroutine t17(x)
116    real x
117    x = x + 1.
118!ERROR: !DIR$ IGNORE_TKR directive must appear in the specification part
119!dir$ ignore_tkr x
120  end
121
122  subroutine t18(x)
123!ERROR: 'q' is not a valid letter for !DIR$ IGNORE_TKR directive
124!dir$ ignore_tkr(q) x
125    real x
126    x = x + 1.
127  end
128
129  subroutine t19(x)
130    real x
131   contains
132    subroutine inner
133!ERROR: 'x' must be local to this subprogram
134!dir$ ignore_tkr x
135    end
136  end
137
138  subroutine t20(x)
139    real x
140    block
141!ERROR: 'x' must be local to this subprogram
142!dir$ ignore_tkr x
143    end block
144  end
145
146  subroutine t22(x)
147!dir$ ignore_tkr(r) x
148!WARNING: !DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array
149    real x(..)
150  end
151
152  subroutine t23(x)
153!dir$ ignore_tkr(r) x
154!ERROR: !DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor
155    real x(:)
156  end
157
158end
159
160subroutine bad1(x)
161!dir$ ignore_tkr x
162!ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
163  real, intent(in) :: x
164end
165
166submodule(m) subm
167 contains
168  module subroutine t24(x)
169!dir$ ignore_tkr(t) x
170    real x(:)
171  end
172end
173
174program test
175
176!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
177!dir$ ignore_tkr
178
179  use m
180  real x
181  real a(2)
182  real m(2,2)
183  double precision dx
184
185  call t1(1)
186  call t1(dx)
187  call t1('a')
188  call t1((1.,2.))
189  call t1(.true.)
190
191  call t2(1)
192  !ERROR: Actual argument type 'REAL(8)' is not compatible with dummy argument type 'REAL(4)'
193  call t2(dx)
194  call t2('a')
195  call t2((1.,2.))
196  call t2(.true.)
197
198  !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'REAL(4)'
199  call t3(1)
200  call t3(dx)
201  !ERROR: passing Hollerith or character literal as if it were BOZ
202  call t3('a')
203  !ERROR: Actual argument type 'COMPLEX(4)' is not compatible with dummy argument type 'REAL(4)'
204  call t3((1.,2.))
205  !ERROR: Actual argument type 'LOGICAL(4)' is not compatible with dummy argument type 'REAL(4)'
206  call t3(.true.)
207
208  call t4(x)
209  call t4(m)
210  call t5(x)
211  !WARNING: Actual argument array has fewer elements (2) than dummy argument 'm=' array (4)
212  call t5(a)
213
214  call t6(1)
215  call t6(dx)
216  call t6('a')
217  call t6((1.,2.))
218  call t6(.true.)
219  call t6(a)
220
221  call t8(1)
222  call t8(dx)
223  call t8('a')
224  call t8((1.,2.))
225  call t8(.true.)
226  call t8(a)
227
228 contains
229  subroutine inner(x)
230!dir$ ignore_tkr x
231!ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
232    real, intent(in) :: x
233  end
234end
235