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