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