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 "flang/Common/format.h"
11 #include "flang/Parser/tools.h"
12 #include "flang/Semantics/expression.h"
13 #include "flang/Semantics/tools.h"
14 #include <unordered_map>
15
16 namespace Fortran::semantics {
17
18 // TODO: C1234, C1235 -- defined I/O constraints
19
20 class FormatErrorReporter {
21 public:
FormatErrorReporter(SemanticsContext & context,const parser::CharBlock & formatCharBlock,int errorAllowance=3)22 FormatErrorReporter(SemanticsContext &context,
23 const parser::CharBlock &formatCharBlock, int errorAllowance = 3)
24 : context_{context}, formatCharBlock_{formatCharBlock},
25 errorAllowance_{errorAllowance} {}
26
27 bool Say(const common::FormatMessage &);
28
29 private:
30 SemanticsContext &context_;
31 const parser::CharBlock &formatCharBlock_;
32 int errorAllowance_; // initialized to maximum number of errors to report
33 };
34
Say(const common::FormatMessage & msg)35 bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
36 if (!msg.isError && !context_.warnOnNonstandardUsage()) {
37 return false;
38 }
39 parser::MessageFormattedText text{
40 parser::MessageFixedText(msg.text, strlen(msg.text), msg.isError),
41 msg.arg};
42 if (formatCharBlock_.size()) {
43 // The input format is a folded expression. Error markers span the full
44 // original unfolded expression in formatCharBlock_.
45 context_.Say(formatCharBlock_, text);
46 } else {
47 // The input format is a source expression. Error markers have an offset
48 // and length relative to the beginning of formatCharBlock_.
49 parser::CharBlock messageCharBlock{
50 parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)};
51 context_.Say(messageCharBlock, text);
52 }
53 return msg.isError && --errorAllowance_ <= 0;
54 }
55
Enter(const parser::Statement<common::Indirection<parser::FormatStmt>> & stmt)56 void IoChecker::Enter(
57 const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) {
58 if (!stmt.label) {
59 context_.Say("Format statement must be labeled"_err_en_US); // C1301
60 }
61 const char *formatStart{static_cast<const char *>(
62 std::memchr(stmt.source.begin(), '(', stmt.source.size()))};
63 parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)};
64 FormatErrorReporter reporter{context_, reporterCharBlock};
65 auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }};
66 switch (context_.GetDefaultKind(TypeCategory::Character)) {
67 case 1: {
68 common::FormatValidator<char> validator{formatStart,
69 stmt.source.size() - (formatStart - stmt.source.begin()),
70 reporterWrapper};
71 validator.Check();
72 break;
73 }
74 case 2: { // TODO: Get this to work.
75 common::FormatValidator<char16_t> validator{
76 /*???*/ nullptr, /*???*/ 0, reporterWrapper};
77 validator.Check();
78 break;
79 }
80 case 4: { // TODO: Get this to work.
81 common::FormatValidator<char32_t> validator{
82 /*???*/ nullptr, /*???*/ 0, reporterWrapper};
83 validator.Check();
84 break;
85 }
86 default:
87 CRASH_NO_CASE;
88 }
89 }
90
Enter(const parser::ConnectSpec & spec)91 void IoChecker::Enter(const parser::ConnectSpec &spec) {
92 // ConnectSpec context FileNameExpr
93 if (std::get_if<parser::FileNameExpr>(&spec.u)) {
94 SetSpecifier(IoSpecKind::File);
95 }
96 }
97
Enter(const parser::ConnectSpec::CharExpr & spec)98 void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
99 IoSpecKind specKind{};
100 using ParseKind = parser::ConnectSpec::CharExpr::Kind;
101 switch (std::get<ParseKind>(spec.t)) {
102 case ParseKind::Access:
103 specKind = IoSpecKind::Access;
104 break;
105 case ParseKind::Action:
106 specKind = IoSpecKind::Action;
107 break;
108 case ParseKind::Asynchronous:
109 specKind = IoSpecKind::Asynchronous;
110 break;
111 case ParseKind::Blank:
112 specKind = IoSpecKind::Blank;
113 break;
114 case ParseKind::Decimal:
115 specKind = IoSpecKind::Decimal;
116 break;
117 case ParseKind::Delim:
118 specKind = IoSpecKind::Delim;
119 break;
120 case ParseKind::Encoding:
121 specKind = IoSpecKind::Encoding;
122 break;
123 case ParseKind::Form:
124 specKind = IoSpecKind::Form;
125 break;
126 case ParseKind::Pad:
127 specKind = IoSpecKind::Pad;
128 break;
129 case ParseKind::Position:
130 specKind = IoSpecKind::Position;
131 break;
132 case ParseKind::Round:
133 specKind = IoSpecKind::Round;
134 break;
135 case ParseKind::Sign:
136 specKind = IoSpecKind::Sign;
137 break;
138 case ParseKind::Carriagecontrol:
139 specKind = IoSpecKind::Carriagecontrol;
140 break;
141 case ParseKind::Convert:
142 specKind = IoSpecKind::Convert;
143 break;
144 case ParseKind::Dispose:
145 specKind = IoSpecKind::Dispose;
146 break;
147 }
148 SetSpecifier(specKind);
149 if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
150 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
151 std::string s{parser::ToUpperCaseLetters(*charConst)};
152 if (specKind == IoSpecKind::Access) {
153 flags_.set(Flag::KnownAccess);
154 flags_.set(Flag::AccessDirect, s == "DIRECT");
155 flags_.set(Flag::AccessStream, s == "STREAM");
156 }
157 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
158 if (specKind == IoSpecKind::Carriagecontrol &&
159 (s == "FORTRAN" || s == "NONE")) {
160 context_.Say(parser::FindSourceLocation(spec),
161 "Unimplemented %s value '%s'"_err_en_US,
162 parser::ToUpperCaseLetters(common::EnumToString(specKind)),
163 *charConst);
164 }
165 }
166 }
167
Enter(const parser::ConnectSpec::Newunit & var)168 void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {
169 CheckForDefinableVariable(var, "NEWUNIT");
170 SetSpecifier(IoSpecKind::Newunit);
171 }
172
Enter(const parser::ConnectSpec::Recl & spec)173 void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) {
174 SetSpecifier(IoSpecKind::Recl);
175 if (const std::optional<std::int64_t> recl{
176 GetConstExpr<std::int64_t>(spec)}) {
177 if (*recl <= 0) {
178 context_.Say(parser::FindSourceLocation(spec),
179 "RECL value (%jd) must be positive"_err_en_US,
180 *recl); // 12.5.6.15
181 }
182 }
183 }
184
Enter(const parser::EndLabel &)185 void IoChecker::Enter(const parser::EndLabel &) {
186 SetSpecifier(IoSpecKind::End);
187 }
188
Enter(const parser::EorLabel &)189 void IoChecker::Enter(const parser::EorLabel &) {
190 SetSpecifier(IoSpecKind::Eor);
191 }
192
Enter(const parser::ErrLabel &)193 void IoChecker::Enter(const parser::ErrLabel &) {
194 SetSpecifier(IoSpecKind::Err);
195 }
196
Enter(const parser::FileUnitNumber &)197 void IoChecker::Enter(const parser::FileUnitNumber &) {
198 SetSpecifier(IoSpecKind::Unit);
199 flags_.set(Flag::NumberUnit);
200 }
201
Enter(const parser::Format & spec)202 void IoChecker::Enter(const parser::Format &spec) {
203 SetSpecifier(IoSpecKind::Fmt);
204 flags_.set(Flag::FmtOrNml);
205 std::visit(
206 common::visitors{
207 [&](const parser::Label &) { flags_.set(Flag::LabelFmt); },
208 [&](const parser::Star &) { flags_.set(Flag::StarFmt); },
209 [&](const parser::Expr &format) {
210 const SomeExpr *expr{GetExpr(format)};
211 if (!expr) {
212 return;
213 }
214 auto type{expr->GetType()};
215 if (!type ||
216 (type->category() != TypeCategory::Integer &&
217 type->category() != TypeCategory::Character) ||
218 type->kind() !=
219 context_.defaultKinds().GetDefaultKind(type->category())) {
220 context_.Say(format.source,
221 "Format expression must be default character or integer"_err_en_US);
222 return;
223 }
224 if (type->category() == TypeCategory::Integer) {
225 flags_.set(Flag::AssignFmt);
226 if (expr->Rank() != 0 || !IsVariable(*expr)) {
227 context_.Say(format.source,
228 "Assigned format label must be a scalar variable"_err_en_US);
229 }
230 return;
231 }
232 flags_.set(Flag::CharFmt);
233 const std::optional<std::string> constantFormat{
234 GetConstExpr<std::string>(format)};
235 if (!constantFormat) {
236 return;
237 }
238 // validate constant format -- 12.6.2.2
239 bool isFolded{constantFormat->size() != format.source.size() - 2};
240 parser::CharBlock reporterCharBlock{isFolded
241 ? parser::CharBlock{format.source}
242 : parser::CharBlock{format.source.begin() + 1,
243 static_cast<std::size_t>(0)}};
244 FormatErrorReporter reporter{context_, reporterCharBlock};
245 auto reporterWrapper{
246 [&](const auto &msg) { return reporter.Say(msg); }};
247 switch (context_.GetDefaultKind(TypeCategory::Character)) {
248 case 1: {
249 common::FormatValidator<char> validator{constantFormat->c_str(),
250 constantFormat->length(), reporterWrapper, stmt_};
251 validator.Check();
252 break;
253 }
254 case 2: {
255 // TODO: Get this to work. (Maybe combine with earlier instance?)
256 common::FormatValidator<char16_t> validator{
257 /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
258 validator.Check();
259 break;
260 }
261 case 4: {
262 // TODO: Get this to work. (Maybe combine with earlier instance?)
263 common::FormatValidator<char32_t> validator{
264 /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
265 validator.Check();
266 break;
267 }
268 default:
269 CRASH_NO_CASE;
270 }
271 },
272 },
273 spec.u);
274 }
275
Enter(const parser::IdExpr &)276 void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); }
277
Enter(const parser::IdVariable & spec)278 void IoChecker::Enter(const parser::IdVariable &spec) {
279 SetSpecifier(IoSpecKind::Id);
280 const auto *expr{GetExpr(spec)};
281 if (!expr || !expr->GetType()) {
282 return;
283 }
284 CheckForDefinableVariable(spec, "ID");
285 int kind{expr->GetType()->kind()};
286 int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)};
287 if (kind < defaultKind) {
288 context_.Say(
289 "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US,
290 std::move(kind), std::move(defaultKind)); // C1229
291 }
292 }
293
Enter(const parser::InputItem & spec)294 void IoChecker::Enter(const parser::InputItem &spec) {
295 flags_.set(Flag::DataList);
296 const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)};
297 if (!var) {
298 return;
299 }
300 CheckForDefinableVariable(*var, "Input");
301 }
302
Enter(const parser::InquireSpec & spec)303 void IoChecker::Enter(const parser::InquireSpec &spec) {
304 // InquireSpec context FileNameExpr
305 if (std::get_if<parser::FileNameExpr>(&spec.u)) {
306 SetSpecifier(IoSpecKind::File);
307 }
308 }
309
Enter(const parser::InquireSpec::CharVar & spec)310 void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
311 IoSpecKind specKind{};
312 using ParseKind = parser::InquireSpec::CharVar::Kind;
313 switch (std::get<ParseKind>(spec.t)) {
314 case ParseKind::Access:
315 specKind = IoSpecKind::Access;
316 break;
317 case ParseKind::Action:
318 specKind = IoSpecKind::Action;
319 break;
320 case ParseKind::Asynchronous:
321 specKind = IoSpecKind::Asynchronous;
322 break;
323 case ParseKind::Blank:
324 specKind = IoSpecKind::Blank;
325 break;
326 case ParseKind::Decimal:
327 specKind = IoSpecKind::Decimal;
328 break;
329 case ParseKind::Delim:
330 specKind = IoSpecKind::Delim;
331 break;
332 case ParseKind::Direct:
333 specKind = IoSpecKind::Direct;
334 break;
335 case ParseKind::Encoding:
336 specKind = IoSpecKind::Encoding;
337 break;
338 case ParseKind::Form:
339 specKind = IoSpecKind::Form;
340 break;
341 case ParseKind::Formatted:
342 specKind = IoSpecKind::Formatted;
343 break;
344 case ParseKind::Iomsg:
345 specKind = IoSpecKind::Iomsg;
346 break;
347 case ParseKind::Name:
348 specKind = IoSpecKind::Name;
349 break;
350 case ParseKind::Pad:
351 specKind = IoSpecKind::Pad;
352 break;
353 case ParseKind::Position:
354 specKind = IoSpecKind::Position;
355 break;
356 case ParseKind::Read:
357 specKind = IoSpecKind::Read;
358 break;
359 case ParseKind::Readwrite:
360 specKind = IoSpecKind::Readwrite;
361 break;
362 case ParseKind::Round:
363 specKind = IoSpecKind::Round;
364 break;
365 case ParseKind::Sequential:
366 specKind = IoSpecKind::Sequential;
367 break;
368 case ParseKind::Sign:
369 specKind = IoSpecKind::Sign;
370 break;
371 case ParseKind::Status:
372 specKind = IoSpecKind::Status;
373 break;
374 case ParseKind::Stream:
375 specKind = IoSpecKind::Stream;
376 break;
377 case ParseKind::Unformatted:
378 specKind = IoSpecKind::Unformatted;
379 break;
380 case ParseKind::Write:
381 specKind = IoSpecKind::Write;
382 break;
383 case ParseKind::Carriagecontrol:
384 specKind = IoSpecKind::Carriagecontrol;
385 break;
386 case ParseKind::Convert:
387 specKind = IoSpecKind::Convert;
388 break;
389 case ParseKind::Dispose:
390 specKind = IoSpecKind::Dispose;
391 break;
392 }
393 CheckForDefinableVariable(std::get<parser::ScalarDefaultCharVariable>(spec.t),
394 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
395 SetSpecifier(specKind);
396 }
397
Enter(const parser::InquireSpec::IntVar & spec)398 void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) {
399 IoSpecKind specKind{};
400 using ParseKind = parser::InquireSpec::IntVar::Kind;
401 switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) {
402 case ParseKind::Iostat:
403 specKind = IoSpecKind::Iostat;
404 break;
405 case ParseKind::Nextrec:
406 specKind = IoSpecKind::Nextrec;
407 break;
408 case ParseKind::Number:
409 specKind = IoSpecKind::Number;
410 break;
411 case ParseKind::Pos:
412 specKind = IoSpecKind::Pos;
413 break;
414 case ParseKind::Recl:
415 specKind = IoSpecKind::Recl;
416 break;
417 case ParseKind::Size:
418 specKind = IoSpecKind::Size;
419 break;
420 }
421 CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t),
422 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
423 SetSpecifier(specKind);
424 }
425
Enter(const parser::InquireSpec::LogVar & spec)426 void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) {
427 IoSpecKind specKind{};
428 using ParseKind = parser::InquireSpec::LogVar::Kind;
429 switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) {
430 case ParseKind::Exist:
431 specKind = IoSpecKind::Exist;
432 break;
433 case ParseKind::Named:
434 specKind = IoSpecKind::Named;
435 break;
436 case ParseKind::Opened:
437 specKind = IoSpecKind::Opened;
438 break;
439 case ParseKind::Pending:
440 specKind = IoSpecKind::Pending;
441 break;
442 }
443 SetSpecifier(specKind);
444 }
445
Enter(const parser::IoControlSpec & spec)446 void IoChecker::Enter(const parser::IoControlSpec &spec) {
447 // IoControlSpec context Name
448 flags_.set(Flag::IoControlList);
449 if (std::holds_alternative<parser::Name>(spec.u)) {
450 SetSpecifier(IoSpecKind::Nml);
451 flags_.set(Flag::FmtOrNml);
452 }
453 }
454
Enter(const parser::IoControlSpec::Asynchronous & spec)455 void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) {
456 SetSpecifier(IoSpecKind::Asynchronous);
457 if (const std::optional<std::string> charConst{
458 GetConstExpr<std::string>(spec)}) {
459 flags_.set(
460 Flag::AsynchronousYes, parser::ToUpperCaseLetters(*charConst) == "YES");
461 CheckStringValue(IoSpecKind::Asynchronous, *charConst,
462 parser::FindSourceLocation(spec)); // C1223
463 }
464 }
465
Enter(const parser::IoControlSpec::CharExpr & spec)466 void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {
467 IoSpecKind specKind{};
468 using ParseKind = parser::IoControlSpec::CharExpr::Kind;
469 switch (std::get<ParseKind>(spec.t)) {
470 case ParseKind::Advance:
471 specKind = IoSpecKind::Advance;
472 break;
473 case ParseKind::Blank:
474 specKind = IoSpecKind::Blank;
475 break;
476 case ParseKind::Decimal:
477 specKind = IoSpecKind::Decimal;
478 break;
479 case ParseKind::Delim:
480 specKind = IoSpecKind::Delim;
481 break;
482 case ParseKind::Pad:
483 specKind = IoSpecKind::Pad;
484 break;
485 case ParseKind::Round:
486 specKind = IoSpecKind::Round;
487 break;
488 case ParseKind::Sign:
489 specKind = IoSpecKind::Sign;
490 break;
491 }
492 SetSpecifier(specKind);
493 if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
494 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
495 if (specKind == IoSpecKind::Advance) {
496 flags_.set(
497 Flag::AdvanceYes, parser::ToUpperCaseLetters(*charConst) == "YES");
498 }
499 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
500 }
501 }
502
Enter(const parser::IoControlSpec::Pos &)503 void IoChecker::Enter(const parser::IoControlSpec::Pos &) {
504 SetSpecifier(IoSpecKind::Pos);
505 }
506
Enter(const parser::IoControlSpec::Rec &)507 void IoChecker::Enter(const parser::IoControlSpec::Rec &) {
508 SetSpecifier(IoSpecKind::Rec);
509 }
510
Enter(const parser::IoControlSpec::Size & var)511 void IoChecker::Enter(const parser::IoControlSpec::Size &var) {
512 CheckForDefinableVariable(var, "SIZE");
513 SetSpecifier(IoSpecKind::Size);
514 }
515
Enter(const parser::IoUnit & spec)516 void IoChecker::Enter(const parser::IoUnit &spec) {
517 if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
518 if (stmt_ == IoStmtKind::Write) {
519 CheckForDefinableVariable(*var, "Internal file");
520 }
521 if (const auto *expr{GetExpr(*var)}) {
522 if (HasVectorSubscript(*expr)) {
523 context_.Say(parser::FindSourceLocation(*var), // C1201
524 "Internal file must not have a vector subscript"_err_en_US);
525 } else if (!ExprTypeKindIsDefault(*expr, context_)) {
526 // This may be too restrictive; other kinds may be valid.
527 context_.Say(parser::FindSourceLocation(*var), // C1202
528 "Invalid character kind for an internal file variable"_err_en_US);
529 }
530 }
531 SetSpecifier(IoSpecKind::Unit);
532 flags_.set(Flag::InternalUnit);
533 } else if (std::get_if<parser::Star>(&spec.u)) {
534 SetSpecifier(IoSpecKind::Unit);
535 flags_.set(Flag::StarUnit);
536 }
537 }
538
Enter(const parser::MsgVariable & var)539 void IoChecker::Enter(const parser::MsgVariable &var) {
540 if (stmt_ == IoStmtKind::None) {
541 // allocate, deallocate, image control
542 CheckForDefinableVariable(var, "ERRMSG");
543 return;
544 }
545 CheckForDefinableVariable(var, "IOMSG");
546 SetSpecifier(IoSpecKind::Iomsg);
547 }
548
Enter(const parser::OutputItem & item)549 void IoChecker::Enter(const parser::OutputItem &item) {
550 flags_.set(Flag::DataList);
551 if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
552 if (const auto *expr{GetExpr(*x)}) {
553 if (IsProcedurePointer(*expr)) {
554 context_.Say(parser::FindSourceLocation(*x),
555 "Output item must not be a procedure pointer"_err_en_US); // C1233
556 }
557 }
558 }
559 }
560
Enter(const parser::StatusExpr & spec)561 void IoChecker::Enter(const parser::StatusExpr &spec) {
562 SetSpecifier(IoSpecKind::Status);
563 if (const std::optional<std::string> charConst{
564 GetConstExpr<std::string>(spec)}) {
565 // Status values for Open and Close are different.
566 std::string s{parser::ToUpperCaseLetters(*charConst)};
567 if (stmt_ == IoStmtKind::Open) {
568 flags_.set(Flag::KnownStatus);
569 flags_.set(Flag::StatusNew, s == "NEW");
570 flags_.set(Flag::StatusReplace, s == "REPLACE");
571 flags_.set(Flag::StatusScratch, s == "SCRATCH");
572 // CheckStringValue compares for OPEN Status string values.
573 CheckStringValue(
574 IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec));
575 return;
576 }
577 CHECK(stmt_ == IoStmtKind::Close);
578 if (s != "DELETE" && s != "KEEP") {
579 context_.Say(parser::FindSourceLocation(spec),
580 "Invalid STATUS value '%s'"_err_en_US, *charConst);
581 }
582 }
583 }
584
Enter(const parser::StatVariable & var)585 void IoChecker::Enter(const parser::StatVariable &var) {
586 if (stmt_ == IoStmtKind::None) {
587 // allocate, deallocate, image control
588 CheckForDefinableVariable(var, "STAT");
589 return;
590 }
591 CheckForDefinableVariable(var, "IOSTAT");
592 SetSpecifier(IoSpecKind::Iostat);
593 }
594
Leave(const parser::BackspaceStmt &)595 void IoChecker::Leave(const parser::BackspaceStmt &) {
596 CheckForPureSubprogram();
597 CheckForRequiredSpecifier(
598 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
599 Done();
600 }
601
Leave(const parser::CloseStmt &)602 void IoChecker::Leave(const parser::CloseStmt &) {
603 CheckForPureSubprogram();
604 CheckForRequiredSpecifier(
605 flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
606 Done();
607 }
608
Leave(const parser::EndfileStmt &)609 void IoChecker::Leave(const parser::EndfileStmt &) {
610 CheckForPureSubprogram();
611 CheckForRequiredSpecifier(
612 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
613 Done();
614 }
615
Leave(const parser::FlushStmt &)616 void IoChecker::Leave(const parser::FlushStmt &) {
617 CheckForPureSubprogram();
618 CheckForRequiredSpecifier(
619 flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
620 Done();
621 }
622
Leave(const parser::InquireStmt & stmt)623 void IoChecker::Leave(const parser::InquireStmt &stmt) {
624 if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {
625 CheckForPureSubprogram();
626 // Inquire by unit or by file (vs. by output list).
627 CheckForRequiredSpecifier(
628 flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File),
629 "UNIT number or FILE"); // C1246
630 CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
631 CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
632 }
633 Done();
634 }
635
Leave(const parser::OpenStmt &)636 void IoChecker::Leave(const parser::OpenStmt &) {
637 CheckForPureSubprogram();
638 CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) ||
639 specifierSet_.test(IoSpecKind::Newunit),
640 "UNIT or NEWUNIT"); // C1204, C1205
641 CheckForProhibitedSpecifier(
642 IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205
643 CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'",
644 IoSpecKind::File); // 12.5.6.10
645 CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace),
646 "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10
647 CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch),
648 "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10
649 if (flags_.test(Flag::KnownStatus)) {
650 CheckForRequiredSpecifier(IoSpecKind::Newunit,
651 specifierSet_.test(IoSpecKind::File) ||
652 flags_.test(Flag::StatusScratch),
653 "FILE or STATUS='SCRATCH'"); // 12.5.6.12
654 } else {
655 CheckForRequiredSpecifier(IoSpecKind::Newunit,
656 specifierSet_.test(IoSpecKind::File) ||
657 specifierSet_.test(IoSpecKind::Status),
658 "FILE or STATUS"); // 12.5.6.12
659 }
660 if (flags_.test(Flag::KnownAccess)) {
661 CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect),
662 "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15
663 CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),
664 "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15
665 }
666 Done();
667 }
668
Leave(const parser::PrintStmt &)669 void IoChecker::Leave(const parser::PrintStmt &) {
670 CheckForPureSubprogram();
671 Done();
672 }
673
CheckForDoVariableInNamelist(const Symbol & namelist,SemanticsContext & context,parser::CharBlock namelistLocation)674 static void CheckForDoVariableInNamelist(const Symbol &namelist,
675 SemanticsContext &context, parser::CharBlock namelistLocation) {
676 const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
677 for (const Symbol &object : details.objects()) {
678 context.CheckIndexVarRedefine(namelistLocation, object);
679 }
680 }
681
CheckForDoVariableInNamelistSpec(const parser::ReadStmt & readStmt,SemanticsContext & context)682 static void CheckForDoVariableInNamelistSpec(
683 const parser::ReadStmt &readStmt, SemanticsContext &context) {
684 const std::list<parser::IoControlSpec> &controls{readStmt.controls};
685 for (const auto &control : controls) {
686 if (const auto *namelist{std::get_if<parser::Name>(&control.u)}) {
687 if (const Symbol * symbol{namelist->symbol}) {
688 CheckForDoVariableInNamelist(*symbol, context, namelist->source);
689 }
690 }
691 }
692 }
693
CheckForDoVariable(const parser::ReadStmt & readStmt,SemanticsContext & context)694 static void CheckForDoVariable(
695 const parser::ReadStmt &readStmt, SemanticsContext &context) {
696 CheckForDoVariableInNamelistSpec(readStmt, context);
697 const std::list<parser::InputItem> &items{readStmt.items};
698 for (const auto &item : items) {
699 if (const parser::Variable *
700 variable{std::get_if<parser::Variable>(&item.u)}) {
701 context.CheckIndexVarRedefine(*variable);
702 }
703 }
704 }
705
Leave(const parser::ReadStmt & readStmt)706 void IoChecker::Leave(const parser::ReadStmt &readStmt) {
707 if (!flags_.test(Flag::InternalUnit)) {
708 CheckForPureSubprogram();
709 }
710 CheckForDoVariable(readStmt, context_);
711 if (!flags_.test(Flag::IoControlList)) {
712 Done();
713 return;
714 }
715 LeaveReadWrite();
716 CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
717 CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
718 CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
719 CheckForRequiredSpecifier(IoSpecKind::Eor,
720 specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes),
721 "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2
722 CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml),
723 "FMT or NML"); // C1227
724 CheckForRequiredSpecifier(
725 IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
726 Done();
727 }
728
Leave(const parser::RewindStmt &)729 void IoChecker::Leave(const parser::RewindStmt &) {
730 CheckForRequiredSpecifier(
731 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
732 CheckForPureSubprogram();
733 Done();
734 }
735
Leave(const parser::WaitStmt &)736 void IoChecker::Leave(const parser::WaitStmt &) {
737 CheckForRequiredSpecifier(
738 flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
739 CheckForPureSubprogram();
740 Done();
741 }
742
Leave(const parser::WriteStmt &)743 void IoChecker::Leave(const parser::WriteStmt &) {
744 if (!flags_.test(Flag::InternalUnit)) {
745 CheckForPureSubprogram();
746 }
747 LeaveReadWrite();
748 CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
749 CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
750 CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213
751 CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213
752 CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213
753 CheckForRequiredSpecifier(
754 IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
755 CheckForRequiredSpecifier(IoSpecKind::Delim,
756 flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
757 "FMT=* or NML"); // C1228
758 Done();
759 }
760
LeaveReadWrite() const761 void IoChecker::LeaveReadWrite() const {
762 CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211
763 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216
764 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216
765 CheckForProhibitedSpecifier(
766 IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216
767 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
768 "UNIT=internal-file", IoSpecKind::Pos); // C1219
769 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
770 "UNIT=internal-file", IoSpecKind::Rec); // C1219
771 CheckForProhibitedSpecifier(
772 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219
773 CheckForProhibitedSpecifier(
774 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219
775 CheckForProhibitedSpecifier(
776 IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220
777 CheckForRequiredSpecifier(IoSpecKind::Advance,
778 flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) ||
779 flags_.test(Flag::AssignFmt),
780 "an explicit format"); // C1221
781 CheckForProhibitedSpecifier(IoSpecKind::Advance,
782 flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221
783 CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes),
784 "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit),
785 "UNIT=number"); // C1224
786 CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes),
787 "ASYNCHRONOUS='YES'"); // C1225
788 CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226
789 CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml),
790 "FMT or NML"); // C1227
791 CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml),
792 "FMT or NML"); // C1227
793 }
794
SetSpecifier(IoSpecKind specKind)795 void IoChecker::SetSpecifier(IoSpecKind specKind) {
796 if (stmt_ == IoStmtKind::None) {
797 // FMT may appear on PRINT statements, which don't have any checks.
798 // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements.
799 return;
800 }
801 // C1203, C1207, C1210, C1236, C1239, C1242, C1245
802 if (specifierSet_.test(specKind)) {
803 context_.Say("Duplicate %s specifier"_err_en_US,
804 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
805 }
806 specifierSet_.set(specKind);
807 }
808
CheckStringValue(IoSpecKind specKind,const std::string & value,const parser::CharBlock & source) const809 void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
810 const parser::CharBlock &source) const {
811 static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{
812 {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}},
813 {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}},
814 {IoSpecKind::Advance, {"NO", "YES"}},
815 {IoSpecKind::Asynchronous, {"NO", "YES"}},
816 {IoSpecKind::Blank, {"NULL", "ZERO"}},
817 {IoSpecKind::Decimal, {"COMMA", "POINT"}},
818 {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}},
819 {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}},
820 {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED"}},
821 {IoSpecKind::Pad, {"NO", "YES"}},
822 {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}},
823 {IoSpecKind::Round,
824 {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},
825 {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},
826 {IoSpecKind::Status,
827 // Open values; Close values are {"DELETE", "KEEP"}.
828 {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
829 {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},
830 {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
831 {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
832 };
833 if (!specValues.at(specKind).count(parser::ToUpperCaseLetters(value))) {
834 context_.Say(source, "Invalid %s value '%s'"_err_en_US,
835 parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
836 }
837 }
838
839 // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
840 // need conditions to check, and string arguments to insert into a message.
841 // An IoSpecKind provides both an absence/presence condition and a string
842 // argument (its name). A (condition, string) pair provides an arbitrary
843 // condition and an arbitrary string.
844
CheckForRequiredSpecifier(IoSpecKind specKind) const845 void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {
846 if (!specifierSet_.test(specKind)) {
847 context_.Say("%s statement must have a %s specifier"_err_en_US,
848 parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
849 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
850 }
851 }
852
CheckForRequiredSpecifier(bool condition,const std::string & s) const853 void IoChecker::CheckForRequiredSpecifier(
854 bool condition, const std::string &s) const {
855 if (!condition) {
856 context_.Say("%s statement must have a %s specifier"_err_en_US,
857 parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);
858 }
859 }
860
CheckForRequiredSpecifier(IoSpecKind specKind1,IoSpecKind specKind2) const861 void IoChecker::CheckForRequiredSpecifier(
862 IoSpecKind specKind1, IoSpecKind specKind2) const {
863 if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {
864 context_.Say("If %s appears, %s must also appear"_err_en_US,
865 parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
866 parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
867 }
868 }
869
CheckForRequiredSpecifier(IoSpecKind specKind,bool condition,const std::string & s) const870 void IoChecker::CheckForRequiredSpecifier(
871 IoSpecKind specKind, bool condition, const std::string &s) const {
872 if (specifierSet_.test(specKind) && !condition) {
873 context_.Say("If %s appears, %s must also appear"_err_en_US,
874 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
875 }
876 }
877
CheckForRequiredSpecifier(bool condition,const std::string & s,IoSpecKind specKind) const878 void IoChecker::CheckForRequiredSpecifier(
879 bool condition, const std::string &s, IoSpecKind specKind) const {
880 if (condition && !specifierSet_.test(specKind)) {
881 context_.Say("If %s appears, %s must also appear"_err_en_US, s,
882 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
883 }
884 }
885
CheckForRequiredSpecifier(bool condition1,const std::string & s1,bool condition2,const std::string & s2) const886 void IoChecker::CheckForRequiredSpecifier(bool condition1,
887 const std::string &s1, bool condition2, const std::string &s2) const {
888 if (condition1 && !condition2) {
889 context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
890 }
891 }
892
CheckForProhibitedSpecifier(IoSpecKind specKind) const893 void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
894 if (specifierSet_.test(specKind)) {
895 context_.Say("%s statement must not have a %s specifier"_err_en_US,
896 parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
897 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
898 }
899 }
900
CheckForProhibitedSpecifier(IoSpecKind specKind1,IoSpecKind specKind2) const901 void IoChecker::CheckForProhibitedSpecifier(
902 IoSpecKind specKind1, IoSpecKind specKind2) const {
903 if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {
904 context_.Say("If %s appears, %s must not appear"_err_en_US,
905 parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
906 parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
907 }
908 }
909
CheckForProhibitedSpecifier(IoSpecKind specKind,bool condition,const std::string & s) const910 void IoChecker::CheckForProhibitedSpecifier(
911 IoSpecKind specKind, bool condition, const std::string &s) const {
912 if (specifierSet_.test(specKind) && condition) {
913 context_.Say("If %s appears, %s must not appear"_err_en_US,
914 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
915 }
916 }
917
CheckForProhibitedSpecifier(bool condition,const std::string & s,IoSpecKind specKind) const918 void IoChecker::CheckForProhibitedSpecifier(
919 bool condition, const std::string &s, IoSpecKind specKind) const {
920 if (condition && specifierSet_.test(specKind)) {
921 context_.Say("If %s appears, %s must not appear"_err_en_US, s,
922 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
923 }
924 }
925
926 template <typename A>
CheckForDefinableVariable(const A & var,const std::string & s) const927 void IoChecker::CheckForDefinableVariable(
928 const A &var, const std::string &s) const {
929 const Symbol *sym{
930 GetFirstName(*parser::Unwrap<parser::Variable>(var)).symbol};
931 if (auto whyNot{
932 WhyNotModifiable(*sym, context_.FindScope(*context_.location()))}) {
933 auto at{parser::FindSourceLocation(var)};
934 context_
935 .Say(at, "%s variable '%s' must be definable"_err_en_US, s, sym->name())
936 .Attach(at, std::move(*whyNot), sym->name());
937 }
938 }
939
CheckForPureSubprogram() const940 void IoChecker::CheckForPureSubprogram() const { // C1597
941 CHECK(context_.location());
942 if (FindPureProcedureContaining(context_.FindScope(*context_.location()))) {
943 context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US);
944 }
945 }
946
947 } // namespace Fortran::semantics
948