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::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 
168 void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {
169   CheckForDefinableVariable(var, "NEWUNIT");
170   SetSpecifier(IoSpecKind::Newunit);
171 }
172 
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 
185 void IoChecker::Enter(const parser::EndLabel &) {
186   SetSpecifier(IoSpecKind::End);
187 }
188 
189 void IoChecker::Enter(const parser::EorLabel &) {
190   SetSpecifier(IoSpecKind::Eor);
191 }
192 
193 void IoChecker::Enter(const parser::ErrLabel &) {
194   SetSpecifier(IoSpecKind::Err);
195 }
196 
197 void IoChecker::Enter(const parser::FileUnitNumber &) {
198   SetSpecifier(IoSpecKind::Unit);
199   flags_.set(Flag::NumberUnit);
200 }
201 
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 
276 void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); }
277 
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 
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 
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 
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 
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 
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 
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 
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 
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 
503 void IoChecker::Enter(const parser::IoControlSpec::Pos &) {
504   SetSpecifier(IoSpecKind::Pos);
505 }
506 
507 void IoChecker::Enter(const parser::IoControlSpec::Rec &) {
508   SetSpecifier(IoSpecKind::Rec);
509 }
510 
511 void IoChecker::Enter(const parser::IoControlSpec::Size &var) {
512   CheckForDefinableVariable(var, "SIZE");
513   SetSpecifier(IoSpecKind::Size);
514 }
515 
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 
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 
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       const Symbol *last{GetLastSymbol(*expr)};
554       if (last && IsProcedurePointer(*last)) {
555         context_.Say(parser::FindSourceLocation(*x),
556             "Output item must not be a procedure pointer"_err_en_US); // C1233
557       }
558     }
559   }
560 }
561 
562 void IoChecker::Enter(const parser::StatusExpr &spec) {
563   SetSpecifier(IoSpecKind::Status);
564   if (const std::optional<std::string> charConst{
565           GetConstExpr<std::string>(spec)}) {
566     // Status values for Open and Close are different.
567     std::string s{parser::ToUpperCaseLetters(*charConst)};
568     if (stmt_ == IoStmtKind::Open) {
569       flags_.set(Flag::KnownStatus);
570       flags_.set(Flag::StatusNew, s == "NEW");
571       flags_.set(Flag::StatusReplace, s == "REPLACE");
572       flags_.set(Flag::StatusScratch, s == "SCRATCH");
573       // CheckStringValue compares for OPEN Status string values.
574       CheckStringValue(
575           IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec));
576       return;
577     }
578     CHECK(stmt_ == IoStmtKind::Close);
579     if (s != "DELETE" && s != "KEEP") {
580       context_.Say(parser::FindSourceLocation(spec),
581           "Invalid STATUS value '%s'"_err_en_US, *charConst);
582     }
583   }
584 }
585 
586 void IoChecker::Enter(const parser::StatVariable &var) {
587   if (stmt_ == IoStmtKind::None) {
588     // allocate, deallocate, image control
589     CheckForDefinableVariable(var, "STAT");
590     return;
591   }
592   CheckForDefinableVariable(var, "IOSTAT");
593   SetSpecifier(IoSpecKind::Iostat);
594 }
595 
596 void IoChecker::Leave(const parser::BackspaceStmt &) {
597   CheckForPureSubprogram();
598   CheckForRequiredSpecifier(
599       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
600   Done();
601 }
602 
603 void IoChecker::Leave(const parser::CloseStmt &) {
604   CheckForPureSubprogram();
605   CheckForRequiredSpecifier(
606       flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
607   Done();
608 }
609 
610 void IoChecker::Leave(const parser::EndfileStmt &) {
611   CheckForPureSubprogram();
612   CheckForRequiredSpecifier(
613       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
614   Done();
615 }
616 
617 void IoChecker::Leave(const parser::FlushStmt &) {
618   CheckForPureSubprogram();
619   CheckForRequiredSpecifier(
620       flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
621   Done();
622 }
623 
624 void IoChecker::Leave(const parser::InquireStmt &stmt) {
625   if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {
626     CheckForPureSubprogram();
627     // Inquire by unit or by file (vs. by output list).
628     CheckForRequiredSpecifier(
629         flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File),
630         "UNIT number or FILE"); // C1246
631     CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
632     CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
633   }
634   Done();
635 }
636 
637 void IoChecker::Leave(const parser::OpenStmt &) {
638   CheckForPureSubprogram();
639   CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) ||
640           specifierSet_.test(IoSpecKind::Newunit),
641       "UNIT or NEWUNIT"); // C1204, C1205
642   CheckForProhibitedSpecifier(
643       IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205
644   CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'",
645       IoSpecKind::File); // 12.5.6.10
646   CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace),
647       "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10
648   CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch),
649       "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10
650   if (flags_.test(Flag::KnownStatus)) {
651     CheckForRequiredSpecifier(IoSpecKind::Newunit,
652         specifierSet_.test(IoSpecKind::File) ||
653             flags_.test(Flag::StatusScratch),
654         "FILE or STATUS='SCRATCH'"); // 12.5.6.12
655   } else {
656     CheckForRequiredSpecifier(IoSpecKind::Newunit,
657         specifierSet_.test(IoSpecKind::File) ||
658             specifierSet_.test(IoSpecKind::Status),
659         "FILE or STATUS"); // 12.5.6.12
660   }
661   if (flags_.test(Flag::KnownAccess)) {
662     CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect),
663         "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15
664     CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),
665         "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15
666   }
667   Done();
668 }
669 
670 void IoChecker::Leave(const parser::PrintStmt &) {
671   CheckForPureSubprogram();
672   Done();
673 }
674 
675 static void CheckForDoVariableInNamelist(const Symbol &namelist,
676     SemanticsContext &context, parser::CharBlock namelistLocation) {
677   const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
678   for (const Symbol &object : details.objects()) {
679     context.CheckIndexVarRedefine(namelistLocation, object);
680   }
681 }
682 
683 static void CheckForDoVariableInNamelistSpec(
684     const parser::ReadStmt &readStmt, SemanticsContext &context) {
685   const std::list<parser::IoControlSpec> &controls{readStmt.controls};
686   for (const auto &control : controls) {
687     if (const auto *namelist{std::get_if<parser::Name>(&control.u)}) {
688       if (const Symbol * symbol{namelist->symbol}) {
689         CheckForDoVariableInNamelist(*symbol, context, namelist->source);
690       }
691     }
692   }
693 }
694 
695 static void CheckForDoVariable(
696     const parser::ReadStmt &readStmt, SemanticsContext &context) {
697   CheckForDoVariableInNamelistSpec(readStmt, context);
698   const std::list<parser::InputItem> &items{readStmt.items};
699   for (const auto &item : items) {
700     if (const parser::Variable *
701         variable{std::get_if<parser::Variable>(&item.u)}) {
702       context.CheckIndexVarRedefine(*variable);
703     }
704   }
705 }
706 
707 void IoChecker::Leave(const parser::ReadStmt &readStmt) {
708   if (!flags_.test(Flag::InternalUnit)) {
709     CheckForPureSubprogram();
710   }
711   CheckForDoVariable(readStmt, context_);
712   if (!flags_.test(Flag::IoControlList)) {
713     Done();
714     return;
715   }
716   LeaveReadWrite();
717   CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
718   CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
719   CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
720   CheckForRequiredSpecifier(IoSpecKind::Eor,
721       specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes),
722       "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2
723   CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml),
724       "FMT or NML"); // C1227
725   CheckForRequiredSpecifier(
726       IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
727   Done();
728 }
729 
730 void IoChecker::Leave(const parser::RewindStmt &) {
731   CheckForRequiredSpecifier(
732       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
733   CheckForPureSubprogram();
734   Done();
735 }
736 
737 void IoChecker::Leave(const parser::WaitStmt &) {
738   CheckForRequiredSpecifier(
739       flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
740   CheckForPureSubprogram();
741   Done();
742 }
743 
744 void IoChecker::Leave(const parser::WriteStmt &) {
745   if (!flags_.test(Flag::InternalUnit)) {
746     CheckForPureSubprogram();
747   }
748   LeaveReadWrite();
749   CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
750   CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
751   CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213
752   CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213
753   CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213
754   CheckForRequiredSpecifier(
755       IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
756   CheckForRequiredSpecifier(IoSpecKind::Delim,
757       flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
758       "FMT=* or NML"); // C1228
759   Done();
760 }
761 
762 void IoChecker::LeaveReadWrite() const {
763   CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211
764   CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216
765   CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216
766   CheckForProhibitedSpecifier(
767       IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216
768   CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
769       "UNIT=internal-file", IoSpecKind::Pos); // C1219
770   CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
771       "UNIT=internal-file", IoSpecKind::Rec); // C1219
772   CheckForProhibitedSpecifier(
773       flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219
774   CheckForProhibitedSpecifier(
775       flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219
776   CheckForProhibitedSpecifier(
777       IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220
778   CheckForRequiredSpecifier(IoSpecKind::Advance,
779       flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) ||
780           flags_.test(Flag::AssignFmt),
781       "an explicit format"); // C1221
782   CheckForProhibitedSpecifier(IoSpecKind::Advance,
783       flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221
784   CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes),
785       "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit),
786       "UNIT=number"); // C1224
787   CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes),
788       "ASYNCHRONOUS='YES'"); // C1225
789   CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226
790   CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml),
791       "FMT or NML"); // C1227
792   CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml),
793       "FMT or NML"); // C1227
794 }
795 
796 void IoChecker::SetSpecifier(IoSpecKind specKind) {
797   if (stmt_ == IoStmtKind::None) {
798     // FMT may appear on PRINT statements, which don't have any checks.
799     // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements.
800     return;
801   }
802   // C1203, C1207, C1210, C1236, C1239, C1242, C1245
803   if (specifierSet_.test(specKind)) {
804     context_.Say("Duplicate %s specifier"_err_en_US,
805         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
806   }
807   specifierSet_.set(specKind);
808 }
809 
810 void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
811     const parser::CharBlock &source) const {
812   static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{
813       {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}},
814       {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}},
815       {IoSpecKind::Advance, {"NO", "YES"}},
816       {IoSpecKind::Asynchronous, {"NO", "YES"}},
817       {IoSpecKind::Blank, {"NULL", "ZERO"}},
818       {IoSpecKind::Decimal, {"COMMA", "POINT"}},
819       {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}},
820       {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}},
821       {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED"}},
822       {IoSpecKind::Pad, {"NO", "YES"}},
823       {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}},
824       {IoSpecKind::Round,
825           {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},
826       {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},
827       {IoSpecKind::Status,
828           // Open values; Close values are {"DELETE", "KEEP"}.
829           {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
830       {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},
831       {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
832       {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
833   };
834   auto upper{parser::ToUpperCaseLetters(value)};
835   if (specValues.at(specKind).count(upper) == 0) {
836     if (specKind == IoSpecKind::Access && upper == "APPEND") {
837       if (context_.languageFeatures().ShouldWarn(
838               common::LanguageFeature::OpenAccessAppend)) {
839         context_.Say(source, "ACCESS='%s' interpreted as POSITION='%s'"_en_US,
840             value, upper);
841       }
842     } else {
843       context_.Say(source, "Invalid %s value '%s'"_err_en_US,
844           parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
845     }
846   }
847 }
848 
849 // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
850 // need conditions to check, and string arguments to insert into a message.
851 // An IoSpecKind provides both an absence/presence condition and a string
852 // argument (its name).  A (condition, string) pair provides an arbitrary
853 // condition and an arbitrary string.
854 
855 void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {
856   if (!specifierSet_.test(specKind)) {
857     context_.Say("%s statement must have a %s specifier"_err_en_US,
858         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
859         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
860   }
861 }
862 
863 void IoChecker::CheckForRequiredSpecifier(
864     bool condition, const std::string &s) const {
865   if (!condition) {
866     context_.Say("%s statement must have a %s specifier"_err_en_US,
867         parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);
868   }
869 }
870 
871 void IoChecker::CheckForRequiredSpecifier(
872     IoSpecKind specKind1, IoSpecKind specKind2) const {
873   if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {
874     context_.Say("If %s appears, %s must also appear"_err_en_US,
875         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
876         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
877   }
878 }
879 
880 void IoChecker::CheckForRequiredSpecifier(
881     IoSpecKind specKind, bool condition, const std::string &s) const {
882   if (specifierSet_.test(specKind) && !condition) {
883     context_.Say("If %s appears, %s must also appear"_err_en_US,
884         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
885   }
886 }
887 
888 void IoChecker::CheckForRequiredSpecifier(
889     bool condition, const std::string &s, IoSpecKind specKind) const {
890   if (condition && !specifierSet_.test(specKind)) {
891     context_.Say("If %s appears, %s must also appear"_err_en_US, s,
892         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
893   }
894 }
895 
896 void IoChecker::CheckForRequiredSpecifier(bool condition1,
897     const std::string &s1, bool condition2, const std::string &s2) const {
898   if (condition1 && !condition2) {
899     context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
900   }
901 }
902 
903 void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
904   if (specifierSet_.test(specKind)) {
905     context_.Say("%s statement must not have a %s specifier"_err_en_US,
906         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
907         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
908   }
909 }
910 
911 void IoChecker::CheckForProhibitedSpecifier(
912     IoSpecKind specKind1, IoSpecKind specKind2) const {
913   if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {
914     context_.Say("If %s appears, %s must not appear"_err_en_US,
915         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
916         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
917   }
918 }
919 
920 void IoChecker::CheckForProhibitedSpecifier(
921     IoSpecKind specKind, bool condition, const std::string &s) const {
922   if (specifierSet_.test(specKind) && condition) {
923     context_.Say("If %s appears, %s must not appear"_err_en_US,
924         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
925   }
926 }
927 
928 void IoChecker::CheckForProhibitedSpecifier(
929     bool condition, const std::string &s, IoSpecKind specKind) const {
930   if (condition && specifierSet_.test(specKind)) {
931     context_.Say("If %s appears, %s must not appear"_err_en_US, s,
932         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
933   }
934 }
935 
936 template <typename A>
937 void IoChecker::CheckForDefinableVariable(
938     const A &variable, const std::string &s) const {
939   if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {
940     if (auto expr{AnalyzeExpr(context_, *var)}) {
941       auto at{var->GetSource()};
942       if (auto whyNot{WhyNotModifiable(at, *expr, context_.FindScope(at),
943               true /*vectorSubscriptIsOk*/)}) {
944         const Symbol *base{GetFirstSymbol(*expr)};
945         context_
946             .Say(at, "%s variable '%s' must be definable"_err_en_US, s,
947                 (base ? base->name() : at).ToString())
948             .Attach(std::move(*whyNot));
949       }
950     }
951   }
952 }
953 
954 void IoChecker::CheckForPureSubprogram() const { // C1597
955   CHECK(context_.location());
956   if (const Scope *
957       scope{context_.globalScope().FindScope(*context_.location())}) {
958     if (FindPureProcedureContaining(*scope)) {
959       context_.Say(
960           "External I/O is not allowed in a pure subprogram"_err_en_US);
961     }
962   }
963 }
964 
965 } // namespace Fortran::semantics
966