xref: /llvm-project/flang/lib/Semantics/check-io.cpp (revision 300370c27b31ced572b957b6efdbb2bcee277392) 
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   CheckForRequiredSpecifier(flags_.test(Flag::InternalUnit),
864       "UNIT=internal-file", flags_.test(Flag::FmtOrNml), "FMT or NML");
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       context_.Warn(common::LanguageFeature::OpenAccessAppend, source,
940           "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, upper);
941     } else {
942       context_.Say(source, "Invalid %s value '%s'"_err_en_US,
943           parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
944     }
945   }
946 }
947 
948 // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
949 // need conditions to check, and string arguments to insert into a message.
950 // An IoSpecKind provides both an absence/presence condition and a string
951 // argument (its name).  A (condition, string) pair provides an arbitrary
952 // condition and an arbitrary string.
953 
954 void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {
955   if (!specifierSet_.test(specKind)) {
956     context_.Say("%s statement must have a %s specifier"_err_en_US,
957         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
958         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
959   }
960 }
961 
962 void IoChecker::CheckForRequiredSpecifier(
963     bool condition, const std::string &s) const {
964   if (!condition) {
965     context_.Say("%s statement must have a %s specifier"_err_en_US,
966         parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);
967   }
968 }
969 
970 void IoChecker::CheckForRequiredSpecifier(
971     IoSpecKind specKind1, IoSpecKind specKind2) const {
972   if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {
973     context_.Say("If %s appears, %s must also appear"_err_en_US,
974         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
975         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
976   }
977 }
978 
979 void IoChecker::CheckForRequiredSpecifier(
980     IoSpecKind specKind, bool condition, const std::string &s) const {
981   if (specifierSet_.test(specKind) && !condition) {
982     context_.Say("If %s appears, %s must also appear"_err_en_US,
983         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
984   }
985 }
986 
987 void IoChecker::CheckForRequiredSpecifier(
988     bool condition, const std::string &s, IoSpecKind specKind) const {
989   if (condition && !specifierSet_.test(specKind)) {
990     context_.Say("If %s appears, %s must also appear"_err_en_US, s,
991         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
992   }
993 }
994 
995 void IoChecker::CheckForRequiredSpecifier(bool condition1,
996     const std::string &s1, bool condition2, const std::string &s2) const {
997   if (condition1 && !condition2) {
998     context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
999   }
1000 }
1001 
1002 void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
1003   if (specifierSet_.test(specKind)) {
1004     context_.Say("%s statement must not have a %s specifier"_err_en_US,
1005         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
1006         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
1007   }
1008 }
1009 
1010 void IoChecker::CheckForProhibitedSpecifier(
1011     IoSpecKind specKind1, IoSpecKind specKind2) const {
1012   if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {
1013     context_.Say("If %s appears, %s must not appear"_err_en_US,
1014         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
1015         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
1016   }
1017 }
1018 
1019 void IoChecker::CheckForProhibitedSpecifier(
1020     IoSpecKind specKind, bool condition, const std::string &s) const {
1021   if (specifierSet_.test(specKind) && condition) {
1022     context_.Say("If %s appears, %s must not appear"_err_en_US,
1023         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
1024   }
1025 }
1026 
1027 void IoChecker::CheckForProhibitedSpecifier(
1028     bool condition, const std::string &s, IoSpecKind specKind) const {
1029   if (condition && specifierSet_.test(specKind)) {
1030     context_.Say("If %s appears, %s must not appear"_err_en_US, s,
1031         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
1032   }
1033 }
1034 
1035 template <typename A>
1036 void IoChecker::CheckForDefinableVariable(
1037     const A &variable, const std::string &s) const {
1038   if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {
1039     if (auto expr{AnalyzeExpr(context_, *var)}) {
1040       auto at{var->GetSource()};
1041       if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),
1042               DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},
1043               *expr)}) {
1044         if (whyNot->IsFatal()) {
1045           const Symbol *base{GetFirstSymbol(*expr)};
1046           context_
1047               .Say(at, "%s variable '%s' is not definable"_err_en_US, s,
1048                   (base ? base->name() : at).ToString())
1049               .Attach(
1050                   std::move(whyNot->set_severity(parser::Severity::Because)));
1051         } else {
1052           context_.Say(std::move(*whyNot));
1053         }
1054       }
1055     }
1056   }
1057 }
1058 
1059 void IoChecker::CheckForPureSubprogram() const { // C1597
1060   CHECK(context_.location());
1061   const Scope &scope{context_.FindScope(*context_.location())};
1062   if (FindPureProcedureContaining(scope)) {
1063     context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US);
1064   }
1065 }
1066 
1067 void IoChecker::CheckForUselessIomsg() const {
1068   if (specifierSet_.test(IoSpecKind::Iomsg) &&
1069       !specifierSet_.test(IoSpecKind::Err) &&
1070       !specifierSet_.test(IoSpecKind::Iostat) &&
1071       context_.ShouldWarn(common::UsageWarning::UselessIomsg)) {
1072     context_.Say("IOMSG= is useless without either ERR= or IOSTAT="_warn_en_US);
1073   }
1074 }
1075 
1076 // Seeks out an allocatable or pointer ultimate component that is not
1077 // nested in a nonallocatable/nonpointer component with a specific
1078 // defined I/O procedure.
1079 static const Symbol *FindUnsafeIoDirectComponent(common::DefinedIo which,
1080     const DerivedTypeSpec &derived, const Scope &scope) {
1081   if (HasDefinedIo(which, derived, &scope)) {
1082     return nullptr;
1083   }
1084   if (const Scope * dtScope{derived.scope()}) {
1085     for (const auto &pair : *dtScope) {
1086       const Symbol &symbol{*pair.second};
1087       if (IsAllocatableOrPointer(symbol)) {
1088         return &symbol;
1089       }
1090       if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
1091         if (const DeclTypeSpec * type{details->type()}) {
1092           if (type->category() == DeclTypeSpec::Category::TypeDerived) {
1093             const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()};
1094             if (const Symbol *
1095                 bad{FindUnsafeIoDirectComponent(
1096                     which, componentDerived, scope)}) {
1097               return bad;
1098             }
1099           }
1100         }
1101       }
1102     }
1103   }
1104   return nullptr;
1105 }
1106 
1107 // For a type that does not have a defined I/O subroutine, finds a direct
1108 // component that is a witness to an accessibility violation outside the module
1109 // in which the type was defined.
1110 static const Symbol *FindInaccessibleComponent(common::DefinedIo which,
1111     const DerivedTypeSpec &derived, const Scope &scope) {
1112   if (const Scope * dtScope{derived.scope()}) {
1113     if (const Scope * module{FindModuleContaining(*dtScope)}) {
1114       for (const auto &pair : *dtScope) {
1115         const Symbol &symbol{*pair.second};
1116         if (IsAllocatableOrPointer(symbol)) {
1117           continue; // already an error
1118         }
1119         if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
1120           const DerivedTypeSpec *componentDerived{nullptr};
1121           if (const DeclTypeSpec * type{details->type()}) {
1122             if (type->category() == DeclTypeSpec::Category::TypeDerived) {
1123               componentDerived = &type->derivedTypeSpec();
1124             }
1125           }
1126           if (componentDerived &&
1127               HasDefinedIo(which, *componentDerived, &scope)) {
1128             continue; // this component and its descendents are fine
1129           }
1130           if (symbol.attrs().test(Attr::PRIVATE) &&
1131               !symbol.test(Symbol::Flag::ParentComp)) {
1132             if (!DoesScopeContain(module, scope)) {
1133               return &symbol;
1134             }
1135           }
1136           if (componentDerived) {
1137             if (const Symbol *
1138                 bad{FindInaccessibleComponent(
1139                     which, *componentDerived, scope)}) {
1140               return bad;
1141             }
1142           }
1143         }
1144       }
1145     }
1146   }
1147   return nullptr;
1148 }
1149 
1150 // Fortran 2018, 12.6.3 paragraphs 5 & 7
1151 parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type,
1152     common::DefinedIo which, parser::CharBlock where) const {
1153   if (type.IsUnlimitedPolymorphic()) {
1154     return &context_.Say(
1155         where, "I/O list item may not be unlimited polymorphic"_err_en_US);
1156   } else if (type.category() == TypeCategory::Derived) {
1157     const auto &derived{type.GetDerivedTypeSpec()};
1158     const Scope &scope{context_.FindScope(where)};
1159     if (const Symbol *
1160         bad{FindUnsafeIoDirectComponent(which, derived, scope)}) {
1161       return &context_.SayWithDecl(*bad, where,
1162           "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US,
1163           derived.name(), bad->name());
1164     }
1165     if (!HasDefinedIo(which, derived, &scope)) {
1166       if (type.IsPolymorphic()) {
1167         return &context_.Say(where,
1168             "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US,
1169             derived.name());
1170       }
1171       if ((IsBuiltinDerivedType(&derived, "c_ptr") ||
1172               IsBuiltinDerivedType(&derived, "c_devptr")) &&
1173           !context_.ShouldWarn(common::LanguageFeature::PrintCptr)) {
1174         // Bypass the check below for c_ptr and c_devptr.
1175         return nullptr;
1176       }
1177       if (const Symbol *
1178           bad{FindInaccessibleComponent(which, derived, scope)}) {
1179         return &context_.Say(where,
1180             "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,
1181             derived.name(), bad->name());
1182       }
1183     }
1184   }
1185   return nullptr;
1186 }
1187 
1188 void IoChecker::CheckForBadIoType(const SomeExpr &expr, common::DefinedIo which,
1189     parser::CharBlock where) const {
1190   if (auto type{expr.GetType()}) {
1191     CheckForBadIoType(*type, which, where);
1192   }
1193 }
1194 
1195 parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol,
1196     common::DefinedIo which, parser::CharBlock where) const {
1197   if (auto type{evaluate::DynamicType::From(symbol)}) {
1198     if (auto *msg{CheckForBadIoType(*type, which, where)}) {
1199       evaluate::AttachDeclaration(*msg, symbol);
1200       return msg;
1201     }
1202   }
1203   return nullptr;
1204 }
1205 
1206 void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,
1207     parser::CharBlock namelistLocation) const {
1208   if (!context_.HasError(namelist)) {
1209     const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
1210     for (const Symbol &object : details.objects()) {
1211       context_.CheckIndexVarRedefine(namelistLocation, object);
1212       if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {
1213         evaluate::AttachDeclaration(*msg, namelist);
1214       } else if (which == common::DefinedIo::ReadFormatted) {
1215         if (auto why{WhyNotDefinable(namelistLocation, namelist.owner(),
1216                 DefinabilityFlags{}, object)}) {
1217           context_
1218               .Say(namelistLocation,
1219                   "NAMELIST input group must not contain undefinable item '%s'"_err_en_US,
1220                   object.name())
1221               .Attach(std::move(why->set_severity(parser::Severity::Because)));
1222           context_.SetError(namelist);
1223         }
1224       }
1225     }
1226   }
1227 }
1228 
1229 } // namespace Fortran::semantics
1230