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