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