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