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