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