1 | //===-- lib/Semantics/check-io.cpp ----------------------------------------===// |
---|---|
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #include "check-io.h" |
10 | #include "definable.h" |
11 | #include "flang/Common/format.h" |
12 | #include "flang/Common/indirection.h" |
13 | #include "flang/Evaluate/tools.h" |
14 | #include "flang/Parser/characters.h" |
15 | #include "flang/Parser/tools.h" |
16 | #include "flang/Semantics/expression.h" |
17 | #include "flang/Semantics/tools.h" |
18 | #include <unordered_map> |
19 | |
20 | namespace Fortran::semantics { |
21 | |
22 | // TODO: C1234, C1235 -- defined I/O constraints |
23 | |
24 | class FormatErrorReporter { |
25 | public: |
26 | FormatErrorReporter(SemanticsContext &context, |
27 | const parser::CharBlock &formatCharBlock, int errorAllowance = 3) |
28 | : context_{context}, formatCharBlock_{formatCharBlock}, |
29 | errorAllowance_{errorAllowance} {} |
30 | |
31 | bool Say(const common::FormatMessage &); |
32 | |
33 | private: |
34 | SemanticsContext &context_; |
35 | const parser::CharBlock &formatCharBlock_; |
36 | int errorAllowance_; // initialized to maximum number of errors to report |
37 | }; |
38 | |
39 | bool FormatErrorReporter::Say(const common::FormatMessage &msg) { |
40 | if (!msg.isError && |
41 | !context_.ShouldWarn(common::LanguageFeature::AdditionalFormats)) { |
42 | return false; |
43 | } |
44 | parser::MessageFormattedText text{ |
45 | parser::MessageFixedText{msg.text, strlen(msg.text), |
46 | msg.isError ? parser::Severity::Error : parser::Severity::Warning}, |
47 | msg.arg}; |
48 | if (formatCharBlock_.size()) { |
49 | // The input format is a folded expression. Error markers span the full |
50 | // original unfolded expression in formatCharBlock_. |
51 | context_.Say(formatCharBlock_, text); |
52 | } else { |
53 | // The input format is a source expression. Error markers have an offset |
54 | // and length relative to the beginning of formatCharBlock_. |
55 | parser::CharBlock messageCharBlock{ |
56 | parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)}; |
57 | context_.Say(messageCharBlock, text); |
58 | } |
59 | return msg.isError && --errorAllowance_ <= 0; |
60 | } |
61 | |
62 | void IoChecker::Enter( |
63 | const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) { |
64 | if (!stmt.label) { |
65 | context_.Say("Format statement must be labeled"_err_en_US); // C1301 |
66 | } |
67 | const char *formatStart{static_cast<const char *>( |
68 | std::memchr(stmt.source.begin(), '(', stmt.source.size()))}; |
69 | parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)}; |
70 | FormatErrorReporter reporter{context_, reporterCharBlock}; |
71 | auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }}; |
72 | switch (context_.GetDefaultKind(TypeCategory::Character)) { |
73 | case 1: { |
74 | common::FormatValidator<char> validator{formatStart, |
75 | stmt.source.size() - (formatStart - stmt.source.begin()), |
76 | reporterWrapper}; |
77 | validator.Check(); |
78 | break; |
79 | } |
80 | case 2: { // TODO: Get this to work. |
81 | common::FormatValidator<char16_t> validator{ |
82 | /*???*/ nullptr, /*???*/ 0, reporterWrapper}; |
83 | validator.Check(); |
84 | break; |
85 | } |
86 | case 4: { // TODO: Get this to work. |
87 | common::FormatValidator<char32_t> validator{ |
88 | /*???*/ nullptr, /*???*/ 0, reporterWrapper}; |
89 | validator.Check(); |
90 | break; |
91 | } |
92 | default: |
93 | CRASH_NO_CASE; |
94 | } |
95 | } |
96 | |
97 | void IoChecker::Enter(const parser::ConnectSpec &spec) { |
98 | // ConnectSpec context FileNameExpr |
99 | if (std::get_if<parser::FileNameExpr>(&spec.u)) { |
100 | SetSpecifier(IoSpecKind::File); |
101 | } |
102 | } |
103 | |
104 | // Ignore trailing spaces (12.5.6.2 p1) and convert to upper case |
105 | static std::string Normalize(const std::string &value) { |
106 | auto upper{parser::ToUpperCaseLetters(value)}; |
107 | std::size_t lastNonBlank{upper.find_last_not_of(' ')}; |
108 | upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1); |
109 | return upper; |
110 | } |
111 | |
112 | void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) { |
113 | IoSpecKind specKind{}; |
114 | using ParseKind = parser::ConnectSpec::CharExpr::Kind; |
115 | switch (std::get<ParseKind>(spec.t)) { |
116 | case ParseKind::Access: |
117 | specKind = IoSpecKind::Access; |
118 | break; |
119 | case ParseKind::Action: |
120 | specKind = IoSpecKind::Action; |
121 | break; |
122 | case ParseKind::Asynchronous: |
123 | specKind = IoSpecKind::Asynchronous; |
124 | break; |
125 | case ParseKind::Blank: |
126 | specKind = IoSpecKind::Blank; |
127 | break; |
128 | case ParseKind::Decimal: |
129 | specKind = IoSpecKind::Decimal; |
130 | break; |
131 | case ParseKind::Delim: |
132 | specKind = IoSpecKind::Delim; |
133 | break; |
134 | case ParseKind::Encoding: |
135 | specKind = IoSpecKind::Encoding; |
136 | break; |
137 | case ParseKind::Form: |
138 | specKind = IoSpecKind::Form; |
139 | break; |
140 | case ParseKind::Pad: |
141 | specKind = IoSpecKind::Pad; |
142 | break; |
143 | case ParseKind::Position: |
144 | specKind = IoSpecKind::Position; |
145 | break; |
146 | case ParseKind::Round: |
147 | specKind = IoSpecKind::Round; |
148 | break; |
149 | case ParseKind::Sign: |
150 | specKind = IoSpecKind::Sign; |
151 | break; |
152 | case ParseKind::Carriagecontrol: |
153 | specKind = IoSpecKind::Carriagecontrol; |
154 | break; |
155 | case ParseKind::Convert: |
156 | specKind = IoSpecKind::Convert; |
157 | break; |
158 | case ParseKind::Dispose: |
159 | specKind = IoSpecKind::Dispose; |
160 | break; |
161 | } |
162 | SetSpecifier(specKind); |
163 | if (const std::optional<std::string> charConst{GetConstExpr<std::string>( |
164 | std::get<parser::ScalarDefaultCharExpr>(spec.t))}) { |
165 | std::string s{Normalize(*charConst)}; |
166 | if (specKind == IoSpecKind::Access) { |
167 | flags_.set(Flag::KnownAccess); |
168 | flags_.set(Flag::AccessDirect, s == "DIRECT"); |
169 | flags_.set(Flag::AccessStream, s == "STREAM"); |
170 | } |
171 | CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec)); |
172 | if (specKind == IoSpecKind::Carriagecontrol && |
173 | (s == "FORTRAN"|| s == "NONE")) { |
174 | context_.Say(parser::FindSourceLocation(spec), |
175 | "Unimplemented %s value '%s'"_err_en_US, |
176 | parser::ToUpperCaseLetters(common::EnumToString(specKind)), |
177 | *charConst); |
178 | } |
179 | } |
180 | } |
181 | |
182 | void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) { |
183 | CheckForDefinableVariable(var, "NEWUNIT"); |
184 | SetSpecifier(IoSpecKind::Newunit); |
185 | } |
186 | |
187 | void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) { |
188 | SetSpecifier(IoSpecKind::Recl); |
189 | if (const std::optional<std::int64_t> recl{ |
190 | GetConstExpr<std::int64_t>(spec)}) { |
191 | if (*recl <= 0) { |
192 | context_.Say(parser::FindSourceLocation(spec), |
193 | "RECL value (%jd) must be positive"_err_en_US, |
194 | *recl); // 12.5.6.15 |
195 | } |
196 | } |
197 | } |
198 | |
199 | void IoChecker::Enter(const parser::EndLabel &) { |
200 | SetSpecifier(IoSpecKind::End); |
201 | } |
202 | |
203 | void IoChecker::Enter(const parser::EorLabel &) { |
204 | SetSpecifier(IoSpecKind::Eor); |
205 | } |
206 | |
207 | void IoChecker::Enter(const parser::ErrLabel &) { |
208 | SetSpecifier(IoSpecKind::Err); |
209 | } |
210 | |
211 | void IoChecker::Enter(const parser::FileUnitNumber &) { |
212 | SetSpecifier(IoSpecKind::Unit); |
213 | flags_.set(Flag::NumberUnit); |
214 | } |
215 | |
216 | void IoChecker::Enter(const parser::Format &spec) { |
217 | SetSpecifier(IoSpecKind::Fmt); |
218 | flags_.set(Flag::FmtOrNml); |
219 | common::visit( |
220 | common::visitors{ |
221 | [&](const parser::Label &) { flags_.set(Flag::LabelFmt); }, |
222 | [&](const parser::Star &) { flags_.set(Flag::StarFmt); }, |
223 | [&](const parser::Expr &format) { |
224 | const SomeExpr *expr{GetExpr(context_, format)}; |
225 | if (!expr) { |
226 | return; |
227 | } |
228 | auto type{expr->GetType()}; |
229 | if (type && type->category() == TypeCategory::Integer && |
230 | type->kind() == |
231 | context_.defaultKinds().GetDefaultKind(type->category()) && |
232 | expr->Rank() == 0) { |
233 | flags_.set(Flag::AssignFmt); |
234 | if (!IsVariable(*expr)) { |
235 | context_.Say(format.source, |
236 | "Assigned format label must be a scalar variable"_err_en_US); |
237 | } else { |
238 | context_.Warn(common::LanguageFeature::Assign, format.source, |
239 | "Assigned format labels are deprecated"_port_en_US); |
240 | } |
241 | return; |
242 | } |
243 | if (type && type->category() != TypeCategory::Character && |
244 | (type->category() != TypeCategory::Integer || |
245 | expr->Rank() > 0) && |
246 | context_.IsEnabled( |
247 | common::LanguageFeature::NonCharacterFormat)) { |
248 | // Legacy extension: using non-character variables, typically |
249 | // DATA-initialized with Hollerith, as format expressions. |
250 | context_.Warn(common::LanguageFeature::NonCharacterFormat, |
251 | format.source, |
252 | "Non-character format expression is not standard"_port_en_US); |
253 | } else if (!type || |
254 | type->kind() != |
255 | context_.defaultKinds().GetDefaultKind(type->category())) { |
256 | context_.Say(format.source, |
257 | "Format expression must be default character or default scalar integer"_err_en_US); |
258 | return; |
259 | } |
260 | flags_.set(Flag::CharFmt); |
261 | const std::optional<std::string> constantFormat{ |
262 | GetConstExpr<std::string>(format)}; |
263 | if (!constantFormat) { |
264 | return; |
265 | } |
266 | // validate constant format -- 12.6.2.2 |
267 | bool isFolded{constantFormat->size() != format.source.size() - 2}; |
268 | parser::CharBlock reporterCharBlock{isFolded |
269 | ? parser::CharBlock{format.source} |
270 | : parser::CharBlock{format.source.begin() + 1, |
271 | static_cast<std::size_t>(0)}}; |
272 | FormatErrorReporter reporter{context_, reporterCharBlock}; |
273 | auto reporterWrapper{ |
274 | [&](const auto &msg) { return reporter.Say(msg); }}; |
275 | switch (context_.GetDefaultKind(TypeCategory::Character)) { |
276 | case 1: { |
277 | common::FormatValidator<char> validator{constantFormat->c_str(), |
278 | constantFormat->length(), reporterWrapper, stmt_}; |
279 | validator.Check(); |
280 | break; |
281 | } |
282 | case 2: { |
283 | // TODO: Get this to work. (Maybe combine with earlier instance?) |
284 | common::FormatValidator<char16_t> validator{ |
285 | /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_}; |
286 | validator.Check(); |
287 | break; |
288 | } |
289 | case 4: { |
290 | // TODO: Get this to work. (Maybe combine with earlier instance?) |
291 | common::FormatValidator<char32_t> validator{ |
292 | /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_}; |
293 | validator.Check(); |
294 | break; |
295 | } |
296 | default: |
297 | CRASH_NO_CASE; |
298 | } |
299 | }, |
300 | }, |
301 | spec.u); |
302 | } |
303 | |
304 | void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); } |
305 | |
306 | void IoChecker::Enter(const parser::IdVariable &spec) { |
307 | SetSpecifier(IoSpecKind::Id); |
308 | const auto *expr{GetExpr(context_, spec)}; |
309 | if (!expr || !expr->GetType()) { |
310 | return; |
311 | } |
312 | CheckForDefinableVariable(spec, "ID"); |
313 | int kind{expr->GetType()->kind()}; |
314 | int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)}; |
315 | if (kind < defaultKind) { |
316 | context_.Say( |
317 | "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US, |
318 | std::move(kind), std::move(defaultKind)); // C1229 |
319 | } |
320 | } |
321 | |
322 | void IoChecker::Enter(const parser::InputItem &spec) { |
323 | flags_.set(Flag::DataList); |
324 | const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)}; |
325 | if (!var) { |
326 | return; |
327 | } |
328 | CheckForDefinableVariable(*var, "Input"); |
329 | if (auto expr{AnalyzeExpr(context_, *var)}) { |
330 | CheckForBadIoType(*expr, |
331 | flags_.test(Flag::FmtOrNml) ? common::DefinedIo::ReadFormatted |
332 | : common::DefinedIo::ReadUnformatted, |
333 | var->GetSource()); |
334 | } |
335 | } |
336 | |
337 | void IoChecker::Enter(const parser::InquireSpec &spec) { |
338 | // InquireSpec context FileNameExpr |
339 | if (std::get_if<parser::FileNameExpr>(&spec.u)) { |
340 | SetSpecifier(IoSpecKind::File); |
341 | } |
342 | } |
343 | |
344 | void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) { |
345 | IoSpecKind specKind{}; |
346 | using ParseKind = parser::InquireSpec::CharVar::Kind; |
347 | switch (std::get<ParseKind>(spec.t)) { |
348 | case ParseKind::Access: |
349 | specKind = IoSpecKind::Access; |
350 | break; |
351 | case ParseKind::Action: |
352 | specKind = IoSpecKind::Action; |
353 | break; |
354 | case ParseKind::Asynchronous: |
355 | specKind = IoSpecKind::Asynchronous; |
356 | break; |
357 | case ParseKind::Blank: |
358 | specKind = IoSpecKind::Blank; |
359 | break; |
360 | case ParseKind::Decimal: |
361 | specKind = IoSpecKind::Decimal; |
362 | break; |
363 | case ParseKind::Delim: |
364 | specKind = IoSpecKind::Delim; |
365 | break; |
366 | case ParseKind::Direct: |
367 | specKind = IoSpecKind::Direct; |
368 | break; |
369 | case ParseKind::Encoding: |
370 | specKind = IoSpecKind::Encoding; |
371 | break; |
372 | case ParseKind::Form: |
373 | specKind = IoSpecKind::Form; |
374 | break; |
375 | case ParseKind::Formatted: |
376 | specKind = IoSpecKind::Formatted; |
377 | break; |
378 | case ParseKind::Iomsg: |
379 | specKind = IoSpecKind::Iomsg; |
380 | break; |
381 | case ParseKind::Name: |
382 | specKind = IoSpecKind::Name; |
383 | break; |
384 | case ParseKind::Pad: |
385 | specKind = IoSpecKind::Pad; |
386 | break; |
387 | case ParseKind::Position: |
388 | specKind = IoSpecKind::Position; |
389 | break; |
390 | case ParseKind::Read: |
391 | specKind = IoSpecKind::Read; |
392 | break; |
393 | case ParseKind::Readwrite: |
394 | specKind = IoSpecKind::Readwrite; |
395 | break; |
396 | case ParseKind::Round: |
397 | specKind = IoSpecKind::Round; |
398 | break; |
399 | case ParseKind::Sequential: |
400 | specKind = IoSpecKind::Sequential; |
401 | break; |
402 | case ParseKind::Sign: |
403 | specKind = IoSpecKind::Sign; |
404 | break; |
405 | case ParseKind::Status: |
406 | specKind = IoSpecKind::Status; |
407 | break; |
408 | case ParseKind::Stream: |
409 | specKind = IoSpecKind::Stream; |
410 | break; |
411 | case ParseKind::Unformatted: |
412 | specKind = IoSpecKind::Unformatted; |
413 | break; |
414 | case ParseKind::Write: |
415 | specKind = IoSpecKind::Write; |
416 | break; |
417 | case ParseKind::Carriagecontrol: |
418 | specKind = IoSpecKind::Carriagecontrol; |
419 | break; |
420 | case ParseKind::Convert: |
421 | specKind = IoSpecKind::Convert; |
422 | break; |
423 | case ParseKind::Dispose: |
424 | specKind = IoSpecKind::Dispose; |
425 | break; |
426 | } |
427 | const parser::Variable &var{ |
428 | std::get<parser::ScalarDefaultCharVariable>(spec.t).thing.thing}; |
429 | std::string what{parser::ToUpperCaseLetters(common::EnumToString(specKind))}; |
430 | CheckForDefinableVariable(var, what); |
431 | WarnOnDeferredLengthCharacterScalar( |
432 | context_, GetExpr(context_, var), var.GetSource(), what.c_str()); |
433 | SetSpecifier(specKind); |
434 | } |
435 | |
436 | void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) { |
437 | IoSpecKind specKind{}; |
438 | using ParseKind = parser::InquireSpec::IntVar::Kind; |
439 | switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) { |
440 | case ParseKind::Iostat: |
441 | specKind = IoSpecKind::Iostat; |
442 | break; |
443 | case ParseKind::Nextrec: |
444 | specKind = IoSpecKind::Nextrec; |
445 | break; |
446 | case ParseKind::Number: |
447 | specKind = IoSpecKind::Number; |
448 | break; |
449 | case ParseKind::Pos: |
450 | specKind = IoSpecKind::Pos; |
451 | break; |
452 | case ParseKind::Recl: |
453 | specKind = IoSpecKind::Recl; |
454 | break; |
455 | case ParseKind::Size: |
456 | specKind = IoSpecKind::Size; |
457 | break; |
458 | } |
459 | CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t), |
460 | parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
461 | SetSpecifier(specKind); |
462 | } |
463 | |
464 | void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) { |
465 | IoSpecKind specKind{}; |
466 | using ParseKind = parser::InquireSpec::LogVar::Kind; |
467 | switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) { |
468 | case ParseKind::Exist: |
469 | specKind = IoSpecKind::Exist; |
470 | break; |
471 | case ParseKind::Named: |
472 | specKind = IoSpecKind::Named; |
473 | break; |
474 | case ParseKind::Opened: |
475 | specKind = IoSpecKind::Opened; |
476 | break; |
477 | case ParseKind::Pending: |
478 | specKind = IoSpecKind::Pending; |
479 | break; |
480 | } |
481 | SetSpecifier(specKind); |
482 | } |
483 | |
484 | void IoChecker::Enter(const parser::IoControlSpec &spec) { |
485 | // IoControlSpec context Name |
486 | flags_.set(Flag::IoControlList); |
487 | if (std::holds_alternative<parser::Name>(spec.u)) { |
488 | SetSpecifier(IoSpecKind::Nml); |
489 | flags_.set(Flag::FmtOrNml); |
490 | } |
491 | } |
492 | |
493 | void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) { |
494 | SetSpecifier(IoSpecKind::Asynchronous); |
495 | if (const std::optional<std::string> charConst{ |
496 | GetConstExpr<std::string>(spec)}) { |
497 | flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES"); |
498 | CheckStringValue(IoSpecKind::Asynchronous, *charConst, |
499 | parser::FindSourceLocation(spec)); // C1223 |
500 | } |
501 | } |
502 | |
503 | void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) { |
504 | IoSpecKind specKind{}; |
505 | using ParseKind = parser::IoControlSpec::CharExpr::Kind; |
506 | switch (std::get<ParseKind>(spec.t)) { |
507 | case ParseKind::Advance: |
508 | specKind = IoSpecKind::Advance; |
509 | break; |
510 | case ParseKind::Blank: |
511 | specKind = IoSpecKind::Blank; |
512 | break; |
513 | case ParseKind::Decimal: |
514 | specKind = IoSpecKind::Decimal; |
515 | break; |
516 | case ParseKind::Delim: |
517 | specKind = IoSpecKind::Delim; |
518 | break; |
519 | case ParseKind::Pad: |
520 | specKind = IoSpecKind::Pad; |
521 | break; |
522 | case ParseKind::Round: |
523 | specKind = IoSpecKind::Round; |
524 | break; |
525 | case ParseKind::Sign: |
526 | specKind = IoSpecKind::Sign; |
527 | break; |
528 | } |
529 | SetSpecifier(specKind); |
530 | if (const std::optional<std::string> charConst{GetConstExpr<std::string>( |
531 | std::get<parser::ScalarDefaultCharExpr>(spec.t))}) { |
532 | if (specKind == IoSpecKind::Advance) { |
533 | flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES"); |
534 | } |
535 | CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec)); |
536 | } |
537 | } |
538 | |
539 | void IoChecker::Enter(const parser::IoControlSpec::Pos &) { |
540 | SetSpecifier(IoSpecKind::Pos); |
541 | } |
542 | |
543 | void IoChecker::Enter(const parser::IoControlSpec::Rec &) { |
544 | SetSpecifier(IoSpecKind::Rec); |
545 | } |
546 | |
547 | void IoChecker::Enter(const parser::IoControlSpec::Size &var) { |
548 | CheckForDefinableVariable(var, "SIZE"); |
549 | SetSpecifier(IoSpecKind::Size); |
550 | } |
551 | |
552 | void IoChecker::Enter(const parser::IoUnit &spec) { |
553 | if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) { |
554 | // Only now after generic resolution can it be known whether a function |
555 | // call appearing as UNIT=f() is an integer scalar external unit number |
556 | // or a character pointer for internal I/O. |
557 | const auto *expr{GetExpr(context_, *var)}; |
558 | std::optional<evaluate::DynamicType> dyType; |
559 | if (expr) { |
560 | dyType = expr->GetType(); |
561 | } |
562 | if (dyType && dyType->category() == TypeCategory::Integer) { |
563 | if (expr->Rank() != 0) { |
564 | context_.Say(parser::FindSourceLocation(*var), |
565 | "I/O unit number must be scalar"_err_en_US); |
566 | } |
567 | // In the case of an integer unit number variable, rewrite the parse |
568 | // tree as if the unit had been parsed as a FileUnitNumber in order |
569 | // to ease lowering. |
570 | auto &mutableSpec{const_cast<parser::IoUnit &>(spec)}; |
571 | auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)}; |
572 | auto source{mutableVar.GetSource()}; |
573 | auto typedExpr{std::move(mutableVar.typedExpr)}; |
574 | auto newExpr{common::visit( |
575 | [](auto &&indirection) { |
576 | return parser::Expr{std::move(indirection)}; |
577 | }, |
578 | std::move(mutableVar.u))}; |
579 | newExpr.source = source; |
580 | newExpr.typedExpr = std::move(typedExpr); |
581 | mutableSpec.u = common::Indirection<parser::Expr>{std::move(newExpr)}; |
582 | SetSpecifier(IoSpecKind::Unit); |
583 | flags_.set(Flag::NumberUnit); |
584 | } else if (!dyType || dyType->category() != TypeCategory::Character) { |
585 | SetSpecifier(IoSpecKind::Unit); |
586 | context_.Say(parser::FindSourceLocation(*var), |
587 | "I/O unit must be a character variable or a scalar integer expression"_err_en_US); |
588 | } else { // CHARACTER variable (internal I/O) |
589 | if (stmt_ == IoStmtKind::Write) { |
590 | CheckForDefinableVariable(*var, "Internal file"); |
591 | WarnOnDeferredLengthCharacterScalar( |
592 | context_, expr, var->GetSource(), "Internal file"); |
593 | } |
594 | if (HasVectorSubscript(*expr)) { |
595 | context_.Say(parser::FindSourceLocation(*var), // C1201 |
596 | "Internal file must not have a vector subscript"_err_en_US); |
597 | } |
598 | SetSpecifier(IoSpecKind::Unit); |
599 | flags_.set(Flag::InternalUnit); |
600 | } |
601 | } else if (std::get_if<parser::Star>(&spec.u)) { |
602 | SetSpecifier(IoSpecKind::Unit); |
603 | flags_.set(Flag::StarUnit); |
604 | } else if (const common::Indirection<parser::Expr> *pexpr{ |
605 | std::get_if<common::Indirection<parser::Expr>>(&spec.u)}) { |
606 | const auto *expr{GetExpr(context_, *pexpr)}; |
607 | std::optional<evaluate::DynamicType> dyType; |
608 | if (expr) { |
609 | dyType = expr->GetType(); |
610 | } |
611 | if (!expr || !dyType) { |
612 | context_.Say(parser::FindSourceLocation(*pexpr), |
613 | "I/O unit must be a character variable or scalar integer expression"_err_en_US); |
614 | } else if (dyType->category() != TypeCategory::Integer) { |
615 | context_.Say(parser::FindSourceLocation(*pexpr), |
616 | "I/O unit must be a character variable or a scalar integer expression, but is an expression of type %s"_err_en_US, |
617 | parser::ToUpperCaseLetters(dyType->AsFortran())); |
618 | } else if (expr->Rank() != 0) { |
619 | context_.Say(parser::FindSourceLocation(*pexpr), |
620 | "I/O unit number must be scalar"_err_en_US); |
621 | } |
622 | SetSpecifier(IoSpecKind::Unit); |
623 | flags_.set(Flag::NumberUnit); |
624 | } |
625 | } |
626 | |
627 | void IoChecker::Enter(const parser::MsgVariable &msgVar) { |
628 | const parser::Variable &var{msgVar.v.thing.thing}; |
629 | if (stmt_ == IoStmtKind::None) { |
630 | // allocate, deallocate, image control |
631 | CheckForDefinableVariable(var, "ERRMSG"); |
632 | WarnOnDeferredLengthCharacterScalar( |
633 | context_, GetExpr(context_, var), var.GetSource(), "ERRMSG="); |
634 | } else { |
635 | CheckForDefinableVariable(var, "IOMSG"); |
636 | WarnOnDeferredLengthCharacterScalar( |
637 | context_, GetExpr(context_, var), var.GetSource(), "IOMSG="); |
638 | SetSpecifier(IoSpecKind::Iomsg); |
639 | } |
640 | } |
641 | |
642 | void IoChecker::Enter(const parser::OutputItem &item) { |
643 | flags_.set(Flag::DataList); |
644 | if (const auto *x{std::get_if<parser::Expr>(&item.u)}) { |
645 | if (const auto *expr{GetExpr(context_, *x)}) { |
646 | if (evaluate::IsBOZLiteral(*expr)) { |
647 | context_.Say(parser::FindSourceLocation(*x), // C7109 |
648 | "Output item must not be a BOZ literal constant"_err_en_US); |
649 | } else if (IsProcedure(*expr)) { |
650 | context_.Say(parser::FindSourceLocation(*x), |
651 | "Output item must not be a procedure"_err_en_US); // C1233 |
652 | } |
653 | CheckForBadIoType(*expr, |
654 | flags_.test(Flag::FmtOrNml) ? common::DefinedIo::WriteFormatted |
655 | : common::DefinedIo::WriteUnformatted, |
656 | parser::FindSourceLocation(item)); |
657 | } |
658 | } |
659 | } |
660 | |
661 | void IoChecker::Enter(const parser::StatusExpr &spec) { |
662 | SetSpecifier(IoSpecKind::Status); |
663 | if (const std::optional<std::string> charConst{ |
664 | GetConstExpr<std::string>(spec)}) { |
665 | // Status values for Open and Close are different. |
666 | std::string s{Normalize(*charConst)}; |
667 | if (stmt_ == IoStmtKind::Open) { |
668 | flags_.set(Flag::KnownStatus); |
669 | flags_.set(Flag::StatusNew, s == "NEW"); |
670 | flags_.set(Flag::StatusReplace, s == "REPLACE"); |
671 | flags_.set(Flag::StatusScratch, s == "SCRATCH"); |
672 | // CheckStringValue compares for OPEN Status string values. |
673 | CheckStringValue( |
674 | IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec)); |
675 | return; |
676 | } |
677 | CHECK(stmt_ == IoStmtKind::Close); |
678 | if (s != "DELETE"&& s != "KEEP") { |
679 | context_.Say(parser::FindSourceLocation(spec), |
680 | "Invalid STATUS value '%s'"_err_en_US, *charConst); |
681 | } |
682 | } |
683 | } |
684 | |
685 | void IoChecker::Enter(const parser::StatVariable &var) { |
686 | if (stmt_ == IoStmtKind::None) { |
687 | // allocate, deallocate, image control |
688 | CheckForDefinableVariable(var, "STAT"); |
689 | } else { |
690 | CheckForDefinableVariable(var, "IOSTAT"); |
691 | SetSpecifier(IoSpecKind::Iostat); |
692 | } |
693 | } |
694 | |
695 | void IoChecker::Leave(const parser::BackspaceStmt &) { |
696 | CheckForPureSubprogram(); |
697 | CheckForRequiredSpecifier( |
698 | flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 |
699 | CheckForUselessIomsg(); |
700 | Done(); |
701 | } |
702 | |
703 | void IoChecker::Leave(const parser::CloseStmt &) { |
704 | CheckForPureSubprogram(); |
705 | CheckForRequiredSpecifier( |
706 | flags_.test(Flag::NumberUnit), "UNIT number"); // C1208 |
707 | CheckForUselessIomsg(); |
708 | Done(); |
709 | } |
710 | |
711 | void IoChecker::Leave(const parser::EndfileStmt &) { |
712 | CheckForPureSubprogram(); |
713 | CheckForRequiredSpecifier( |
714 | flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 |
715 | CheckForUselessIomsg(); |
716 | Done(); |
717 | } |
718 | |
719 | void IoChecker::Leave(const parser::FlushStmt &) { |
720 | CheckForPureSubprogram(); |
721 | CheckForRequiredSpecifier( |
722 | flags_.test(Flag::NumberUnit), "UNIT number"); // C1243 |
723 | CheckForUselessIomsg(); |
724 | Done(); |
725 | } |
726 | |
727 | void IoChecker::Leave(const parser::InquireStmt &stmt) { |
728 | if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) { |
729 | CheckForPureSubprogram(); |
730 | // Inquire by unit or by file (vs. by output list). |
731 | CheckForRequiredSpecifier( |
732 | flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File), |
733 | "UNIT number or FILE"); // C1246 |
734 | CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246 |
735 | CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248 |
736 | CheckForUselessIomsg(); |
737 | } |
738 | Done(); |
739 | } |
740 | |
741 | void IoChecker::Leave(const parser::OpenStmt &) { |
742 | CheckForPureSubprogram(); |
743 | CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) || |
744 | specifierSet_.test(IoSpecKind::Newunit), |
745 | "UNIT or NEWUNIT"); // C1204, C1205 |
746 | CheckForProhibitedSpecifier( |
747 | IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205 |
748 | CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'", |
749 | IoSpecKind::File); // 12.5.6.10 |
750 | CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace), |
751 | "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10 |
752 | CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch), |
753 | "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10 |
754 | if (flags_.test(Flag::KnownStatus)) { |
755 | CheckForRequiredSpecifier(IoSpecKind::Newunit, |
756 | specifierSet_.test(IoSpecKind::File) || |
757 | flags_.test(Flag::StatusScratch), |
758 | "FILE or STATUS='SCRATCH'"); // 12.5.6.12 |
759 | } else { |
760 | CheckForRequiredSpecifier(IoSpecKind::Newunit, |
761 | specifierSet_.test(IoSpecKind::File) || |
762 | specifierSet_.test(IoSpecKind::Status), |
763 | "FILE or STATUS"); // 12.5.6.12 |
764 | } |
765 | if (flags_.test(Flag::KnownAccess)) { |
766 | CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect), |
767 | "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15 |
768 | CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream), |
769 | "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15 |
770 | } |
771 | CheckForUselessIomsg(); |
772 | Done(); |
773 | } |
774 | |
775 | void IoChecker::Leave(const parser::PrintStmt &) { |
776 | CheckForPureSubprogram(); |
777 | CheckForUselessIomsg(); |
778 | Done(); |
779 | } |
780 | |
781 | static const parser::Name *FindNamelist( |
782 | const std::list<parser::IoControlSpec> &controls) { |
783 | for (const auto &control : controls) { |
784 | if (const parser::Name * namelist{std::get_if<parser::Name>(&control.u)}) { |
785 | if (namelist->symbol && |
786 | namelist->symbol->GetUltimate().has<NamelistDetails>()) { |
787 | return namelist; |
788 | } |
789 | } |
790 | } |
791 | return nullptr; |
792 | } |
793 | |
794 | static void CheckForDoVariable( |
795 | const parser::ReadStmt &readStmt, SemanticsContext &context) { |
796 | const std::list<parser::InputItem> &items{readStmt.items}; |
797 | for (const auto &item : items) { |
798 | if (const parser::Variable * |
799 | variable{std::get_if<parser::Variable>(&item.u)}) { |
800 | context.CheckIndexVarRedefine(*variable); |
801 | } |
802 | } |
803 | } |
804 | |
805 | void IoChecker::Leave(const parser::ReadStmt &readStmt) { |
806 | if (!flags_.test(Flag::InternalUnit)) { |
807 | CheckForPureSubprogram(); |
808 | } |
809 | if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) { |
810 | if (namelist->symbol) { |
811 | CheckNamelist(*namelist->symbol, common::DefinedIo::ReadFormatted, |
812 | namelist->source); |
813 | } |
814 | } |
815 | CheckForDoVariable(readStmt, context_); |
816 | if (!flags_.test(Flag::IoControlList)) { |
817 | Done(); |
818 | return; |
819 | } |
820 | LeaveReadWrite(); |
821 | CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212 |
822 | CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212 |
823 | CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220 |
824 | if (specifierSet_.test(IoSpecKind::Size)) { |
825 | // F'2023 C1214 - allow with a warning |
826 | if (context_.ShouldWarn(common::LanguageFeature::ListDirectedSize)) { |
827 | if (specifierSet_.test(IoSpecKind::Nml)) { |
828 | context_.Say("If NML appears, SIZE should not appear"_port_en_US); |
829 | } else if (flags_.test(Flag::StarFmt)) { |
830 | context_.Say("If FMT=* appears, SIZE should not appear"_port_en_US); |
831 | } |
832 | } |
833 | } |
834 | CheckForRequiredSpecifier(IoSpecKind::Eor, |
835 | specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes), |
836 | "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2 |
837 | CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml), |
838 | "FMT or NML"); // C1227 |
839 | CheckForRequiredSpecifier( |
840 | IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227 |
841 | Done(); |
842 | } |
843 | |
844 | void IoChecker::Leave(const parser::RewindStmt &) { |
845 | CheckForRequiredSpecifier( |
846 | flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 |
847 | CheckForPureSubprogram(); |
848 | CheckForUselessIomsg(); |
849 | Done(); |
850 | } |
851 | |
852 | void IoChecker::Leave(const parser::WaitStmt &) { |
853 | CheckForRequiredSpecifier( |
854 | flags_.test(Flag::NumberUnit), "UNIT number"); // C1237 |
855 | CheckForPureSubprogram(); |
856 | CheckForUselessIomsg(); |
857 | Done(); |
858 | } |
859 | |
860 | void IoChecker::Leave(const parser::WriteStmt &writeStmt) { |
861 | if (!flags_.test(Flag::InternalUnit)) { |
862 | CheckForPureSubprogram(); |
863 | } |
864 | if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) { |
865 | if (namelist->symbol) { |
866 | CheckNamelist(*namelist->symbol, common::DefinedIo::WriteFormatted, |
867 | namelist->source); |
868 | } |
869 | } |
870 | LeaveReadWrite(); |
871 | CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213 |
872 | CheckForProhibitedSpecifier(IoSpecKind::End); // C1213 |
873 | CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213 |
874 | CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213 |
875 | CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213 |
876 | CheckForRequiredSpecifier( |
877 | IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227 |
878 | CheckForRequiredSpecifier(IoSpecKind::Delim, |
879 | flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml), |
880 | "FMT=* or NML"); // C1228 |
881 | Done(); |
882 | } |
883 | |
884 | void IoChecker::LeaveReadWrite() const { |
885 | CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211 |
886 | CheckForRequiredSpecifier(flags_.test(Flag::InternalUnit), |
887 | "UNIT=internal-file", flags_.test(Flag::FmtOrNml), "FMT or NML"); |
888 | CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216 |
889 | CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216 |
890 | CheckForProhibitedSpecifier( |
891 | IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216 |
892 | CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit), |
893 | "UNIT=internal-file", IoSpecKind::Pos); // C1219 |
894 | CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit), |
895 | "UNIT=internal-file", IoSpecKind::Rec); // C1219 |
896 | CheckForProhibitedSpecifier( |
897 | flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219 |
898 | CheckForProhibitedSpecifier( |
899 | flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219 |
900 | CheckForProhibitedSpecifier( |
901 | IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220 |
902 | CheckForRequiredSpecifier(IoSpecKind::Advance, |
903 | flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) || |
904 | flags_.test(Flag::AssignFmt), |
905 | "an explicit format"); // C1221 |
906 | CheckForProhibitedSpecifier(IoSpecKind::Advance, |
907 | flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221 |
908 | CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes), |
909 | "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit), |
910 | "UNIT=number"); // C1224 |
911 | CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes), |
912 | "ASYNCHRONOUS='YES'"); // C1225 |
913 | CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226 |
914 | CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml), |
915 | "FMT or NML"); // C1227 |
916 | CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml), |
917 | "FMT or NML"); // C1227 |
918 | CheckForUselessIomsg(); |
919 | } |
920 | |
921 | void IoChecker::SetSpecifier(IoSpecKind specKind) { |
922 | if (stmt_ == IoStmtKind::None) { |
923 | // FMT may appear on PRINT statements, which don't have any checks. |
924 | // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements. |
925 | return; |
926 | } |
927 | // C1203, C1207, C1210, C1236, C1239, C1242, C1245 |
928 | if (specifierSet_.test(specKind)) { |
929 | context_.Say("Duplicate %s specifier"_err_en_US, |
930 | parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
931 | } |
932 | specifierSet_.set(specKind); |
933 | } |
934 | |
935 | void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value, |
936 | const parser::CharBlock &source) const { |
937 | static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{ |
938 | {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}}, |
939 | {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}}, |
940 | {IoSpecKind::Advance, {"NO", "YES"}}, |
941 | {IoSpecKind::Asynchronous, {"NO", "YES"}}, |
942 | {IoSpecKind::Blank, {"NULL", "ZERO"}}, |
943 | {IoSpecKind::Decimal, {"COMMA", "POINT"}}, |
944 | {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}}, |
945 | {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}}, |
946 | {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED", "BINARY"}}, |
947 | {IoSpecKind::Pad, {"NO", "YES"}}, |
948 | {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}}, |
949 | {IoSpecKind::Round, |
950 | {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}}, |
951 | {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}}, |
952 | {IoSpecKind::Status, |
953 | // Open values; Close values are {"DELETE", "KEEP"}. |
954 | {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}}, |
955 | {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}}, |
956 | {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE", "SWAP"}}, |
957 | {IoSpecKind::Dispose, {"DELETE", "KEEP"}}, |
958 | }; |
959 | auto upper{Normalize(value)}; |
960 | if (specValues.at(specKind).count(upper) == 0) { |
961 | if (specKind == IoSpecKind::Access && upper == "APPEND") { |
962 | context_.Warn(common::LanguageFeature::OpenAccessAppend, source, |
963 | "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, upper); |
964 | } else { |
965 | context_.Say(source, "Invalid %s value '%s'"_err_en_US, |
966 | parser::ToUpperCaseLetters(common::EnumToString(specKind)), value); |
967 | } |
968 | } |
969 | } |
970 | |
971 | // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions |
972 | // need conditions to check, and string arguments to insert into a message. |
973 | // An IoSpecKind provides both an absence/presence condition and a string |
974 | // argument (its name). A (condition, string) pair provides an arbitrary |
975 | // condition and an arbitrary string. |
976 | |
977 | void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const { |
978 | if (!specifierSet_.test(specKind)) { |
979 | context_.Say("%s statement must have a %s specifier"_err_en_US, |
980 | parser::ToUpperCaseLetters(common::EnumToString(stmt_)), |
981 | parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
982 | } |
983 | } |
984 | |
985 | void IoChecker::CheckForRequiredSpecifier( |
986 | bool condition, const std::string &s) const { |
987 | if (!condition) { |
988 | context_.Say("%s statement must have a %s specifier"_err_en_US, |
989 | parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s); |
990 | } |
991 | } |
992 | |
993 | void IoChecker::CheckForRequiredSpecifier( |
994 | IoSpecKind specKind1, IoSpecKind specKind2) const { |
995 | if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) { |
996 | context_.Say("If %s appears, %s must also appear"_err_en_US, |
997 | parser::ToUpperCaseLetters(common::EnumToString(specKind1)), |
998 | parser::ToUpperCaseLetters(common::EnumToString(specKind2))); |
999 | } |
1000 | } |
1001 | |
1002 | void IoChecker::CheckForRequiredSpecifier( |
1003 | IoSpecKind specKind, bool condition, const std::string &s) const { |
1004 | if (specifierSet_.test(specKind) && !condition) { |
1005 | context_.Say("If %s appears, %s must also appear"_err_en_US, |
1006 | parser::ToUpperCaseLetters(common::EnumToString(specKind)), s); |
1007 | } |
1008 | } |
1009 | |
1010 | void IoChecker::CheckForRequiredSpecifier( |
1011 | bool condition, const std::string &s, IoSpecKind specKind) const { |
1012 | if (condition && !specifierSet_.test(specKind)) { |
1013 | context_.Say("If %s appears, %s must also appear"_err_en_US, s, |
1014 | parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
1015 | } |
1016 | } |
1017 | |
1018 | void IoChecker::CheckForRequiredSpecifier(bool condition1, |
1019 | const std::string &s1, bool condition2, const std::string &s2) const { |
1020 | if (condition1 && !condition2) { |
1021 | context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2); |
1022 | } |
1023 | } |
1024 | |
1025 | void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const { |
1026 | if (specifierSet_.test(specKind)) { |
1027 | context_.Say("%s statement must not have a %s specifier"_err_en_US, |
1028 | parser::ToUpperCaseLetters(common::EnumToString(stmt_)), |
1029 | parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
1030 | } |
1031 | } |
1032 | |
1033 | void IoChecker::CheckForProhibitedSpecifier( |
1034 | IoSpecKind specKind1, IoSpecKind specKind2) const { |
1035 | if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) { |
1036 | context_.Say("If %s appears, %s must not appear"_err_en_US, |
1037 | parser::ToUpperCaseLetters(common::EnumToString(specKind1)), |
1038 | parser::ToUpperCaseLetters(common::EnumToString(specKind2))); |
1039 | } |
1040 | } |
1041 | |
1042 | void IoChecker::CheckForProhibitedSpecifier( |
1043 | IoSpecKind specKind, bool condition, const std::string &s) const { |
1044 | if (specifierSet_.test(specKind) && condition) { |
1045 | context_.Say("If %s appears, %s must not appear"_err_en_US, |
1046 | parser::ToUpperCaseLetters(common::EnumToString(specKind)), s); |
1047 | } |
1048 | } |
1049 | |
1050 | void IoChecker::CheckForProhibitedSpecifier( |
1051 | bool condition, const std::string &s, IoSpecKind specKind) const { |
1052 | if (condition && specifierSet_.test(specKind)) { |
1053 | context_.Say("If %s appears, %s must not appear"_err_en_US, s, |
1054 | parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
1055 | } |
1056 | } |
1057 | |
1058 | template <typename A> |
1059 | void IoChecker::CheckForDefinableVariable( |
1060 | const A &variable, const std::string &s) const { |
1061 | if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) { |
1062 | if (auto expr{AnalyzeExpr(context_, *var)}) { |
1063 | auto at{var->GetSource()}; |
1064 | if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at), |
1065 | DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, |
1066 | *expr)}) { |
1067 | if (whyNot->IsFatal()) { |
1068 | const Symbol *base{GetFirstSymbol(*expr)}; |
1069 | context_ |
1070 | .Say(at, "%s variable '%s' is not definable"_err_en_US, s, |
1071 | (base ? base->name() : at).ToString()) |
1072 | .Attach( |
1073 | std::move(whyNot->set_severity(parser::Severity::Because))); |
1074 | } else { |
1075 | context_.Say(std::move(*whyNot)); |
1076 | } |
1077 | } |
1078 | } |
1079 | } |
1080 | } |
1081 | |
1082 | void IoChecker::CheckForPureSubprogram() const { // C1597 |
1083 | CHECK(context_.location()); |
1084 | const Scope &scope{context_.FindScope(*context_.location())}; |
1085 | if (FindPureProcedureContaining(scope)) { |
1086 | context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US); |
1087 | } |
1088 | } |
1089 | |
1090 | void IoChecker::CheckForUselessIomsg() const { |
1091 | if (specifierSet_.test(IoSpecKind::Iomsg) && |
1092 | !specifierSet_.test(IoSpecKind::Err) && |
1093 | !specifierSet_.test(IoSpecKind::Iostat) && |
1094 | context_.ShouldWarn(common::UsageWarning::UselessIomsg)) { |
1095 | context_.Say("IOMSG= is useless without either ERR= or IOSTAT="_warn_en_US); |
1096 | } |
1097 | } |
1098 | |
1099 | // Seeks out an allocatable or pointer ultimate component that is not |
1100 | // nested in a nonallocatable/nonpointer component with a specific |
1101 | // defined I/O procedure. |
1102 | static const Symbol *FindUnsafeIoDirectComponent(common::DefinedIo which, |
1103 | const DerivedTypeSpec &derived, const Scope &scope) { |
1104 | if (HasDefinedIo(which, derived, &scope)) { |
1105 | return nullptr; |
1106 | } |
1107 | if (const Scope * dtScope{derived.scope()}) { |
1108 | for (const auto &pair : *dtScope) { |
1109 | const Symbol &symbol{*pair.second}; |
1110 | if (IsAllocatableOrPointer(symbol)) { |
1111 | return &symbol; |
1112 | } |
1113 | if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { |
1114 | if (const DeclTypeSpec * type{details->type()}) { |
1115 | if (type->category() == DeclTypeSpec::Category::TypeDerived) { |
1116 | const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()}; |
1117 | if (const Symbol * |
1118 | bad{FindUnsafeIoDirectComponent( |
1119 | which, componentDerived, scope)}) { |
1120 | return bad; |
1121 | } |
1122 | } |
1123 | } |
1124 | } |
1125 | } |
1126 | } |
1127 | return nullptr; |
1128 | } |
1129 | |
1130 | // For a type that does not have a defined I/O subroutine, finds a direct |
1131 | // component that is a witness to an accessibility violation outside the module |
1132 | // in which the type was defined. |
1133 | static const Symbol *FindInaccessibleComponent(common::DefinedIo which, |
1134 | const DerivedTypeSpec &derived, const Scope &scope) { |
1135 | if (const Scope * dtScope{derived.scope()}) { |
1136 | if (const Scope * module{FindModuleContaining(*dtScope)}) { |
1137 | for (const auto &pair : *dtScope) { |
1138 | const Symbol &symbol{*pair.second}; |
1139 | if (IsAllocatableOrPointer(symbol)) { |
1140 | continue; // already an error |
1141 | } |
1142 | if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { |
1143 | const DerivedTypeSpec *componentDerived{nullptr}; |
1144 | if (const DeclTypeSpec * type{details->type()}) { |
1145 | if (type->category() == DeclTypeSpec::Category::TypeDerived) { |
1146 | componentDerived = &type->derivedTypeSpec(); |
1147 | } |
1148 | } |
1149 | if (componentDerived && |
1150 | HasDefinedIo(which, *componentDerived, &scope)) { |
1151 | continue; // this component and its descendents are fine |
1152 | } |
1153 | if (symbol.attrs().test(Attr::PRIVATE) && |
1154 | !symbol.test(Symbol::Flag::ParentComp)) { |
1155 | if (!DoesScopeContain(module, scope)) { |
1156 | return &symbol; |
1157 | } |
1158 | } |
1159 | if (componentDerived) { |
1160 | if (const Symbol * |
1161 | bad{FindInaccessibleComponent( |
1162 | which, *componentDerived, scope)}) { |
1163 | return bad; |
1164 | } |
1165 | } |
1166 | } |
1167 | } |
1168 | } |
1169 | } |
1170 | return nullptr; |
1171 | } |
1172 | |
1173 | // Fortran 2018, 12.6.3 paragraphs 5 & 7 |
1174 | parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type, |
1175 | common::DefinedIo which, parser::CharBlock where) const { |
1176 | if (type.IsUnlimitedPolymorphic()) { |
1177 | return &context_.Say( |
1178 | where, "I/O list item may not be unlimited polymorphic"_err_en_US); |
1179 | } else if (type.category() == TypeCategory::Derived) { |
1180 | const auto &derived{type.GetDerivedTypeSpec()}; |
1181 | const Scope &scope{context_.FindScope(where)}; |
1182 | if (const Symbol * |
1183 | bad{FindUnsafeIoDirectComponent(which, derived, scope)}) { |
1184 | return &context_.SayWithDecl(*bad, where, |
1185 | "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US, |
1186 | derived.name(), bad->name()); |
1187 | } |
1188 | if (!HasDefinedIo(which, derived, &scope)) { |
1189 | if (type.IsPolymorphic()) { |
1190 | return &context_.Say(where, |
1191 | "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US, |
1192 | derived.name()); |
1193 | } |
1194 | if ((IsBuiltinDerivedType(&derived, "c_ptr") || |
1195 | IsBuiltinDerivedType(&derived, "c_devptr")) && |
1196 | !context_.ShouldWarn(common::LanguageFeature::PrintCptr)) { |
1197 | // Bypass the check below for c_ptr and c_devptr. |
1198 | return nullptr; |
1199 | } |
1200 | if (const Symbol * |
1201 | bad{FindInaccessibleComponent(which, derived, scope)}) { |
1202 | return &context_.Say(where, |
1203 | "I/O of the derived type '%s' may not be performed without defined I/O in a scope in which a direct component like '%s' is inaccessible"_err_en_US, |
1204 | derived.name(), bad->name()); |
1205 | } |
1206 | } |
1207 | } |
1208 | return nullptr; |
1209 | } |
1210 | |
1211 | void IoChecker::CheckForBadIoType(const SomeExpr &expr, common::DefinedIo which, |
1212 | parser::CharBlock where) const { |
1213 | if (auto type{expr.GetType()}) { |
1214 | CheckForBadIoType(*type, which, where); |
1215 | } |
1216 | } |
1217 | |
1218 | parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol, |
1219 | common::DefinedIo which, parser::CharBlock where) const { |
1220 | if (auto type{evaluate::DynamicType::From(symbol)}) { |
1221 | if (auto *msg{CheckForBadIoType(*type, which, where)}) { |
1222 | evaluate::AttachDeclaration(*msg, symbol); |
1223 | return msg; |
1224 | } |
1225 | } |
1226 | return nullptr; |
1227 | } |
1228 | |
1229 | void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which, |
1230 | parser::CharBlock namelistLocation) const { |
1231 | if (!context_.HasError(namelist)) { |
1232 | const auto &details{namelist.GetUltimate().get<NamelistDetails>()}; |
1233 | for (const Symbol &object : details.objects()) { |
1234 | context_.CheckIndexVarRedefine(namelistLocation, object); |
1235 | if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) { |
1236 | evaluate::AttachDeclaration(*msg, namelist); |
1237 | } else if (which == common::DefinedIo::ReadFormatted) { |
1238 | if (auto why{WhyNotDefinable(namelistLocation, namelist.owner(), |
1239 | DefinabilityFlags{}, object)}) { |
1240 | context_ |
1241 | .Say(namelistLocation, |
1242 | "NAMELIST input group must not contain undefinable item '%s'"_err_en_US, |
1243 | object.name()) |
1244 | .Attach(std::move(why->set_severity(parser::Severity::Because))); |
1245 | context_.SetError(namelist); |
1246 | } |
1247 | } |
1248 | } |
1249 | } |
1250 | } |
1251 | |
1252 | } // namespace Fortran::semantics |
1253 |
Definitions
- FormatErrorReporter
- FormatErrorReporter
- Say
- Enter
- Enter
- Normalize
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Enter
- Leave
- Leave
- Leave
- Leave
- Leave
- Leave
- Leave
- FindNamelist
- CheckForDoVariable
- Leave
- Leave
- Leave
- Leave
- LeaveReadWrite
- SetSpecifier
- CheckStringValue
- CheckForRequiredSpecifier
- CheckForRequiredSpecifier
- CheckForRequiredSpecifier
- CheckForRequiredSpecifier
- CheckForRequiredSpecifier
- CheckForRequiredSpecifier
- CheckForProhibitedSpecifier
- CheckForProhibitedSpecifier
- CheckForProhibitedSpecifier
- CheckForProhibitedSpecifier
- CheckForDefinableVariable
- CheckForPureSubprogram
- CheckForUselessIomsg
- FindUnsafeIoDirectComponent
- FindInaccessibleComponent
- CheckForBadIoType
- CheckForBadIoType
- CheckForBadIoType
Learn to use CMake with our Intro Training
Find out more