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

source code of flang/lib/Semantics/check-io.cpp