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