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