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