1255 lines · cpp
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-exception6//7//===----------------------------------------------------------------------===//8 9#include "check-io.h"10#include "definable.h"11#include "flang/Common/format.h"12#include "flang/Common/indirection.h"13#include "flang/Evaluate/tools.h"14#include "flang/Parser/characters.h"15#include "flang/Parser/tools.h"16#include "flang/Semantics/expression.h"17#include "flang/Semantics/tools.h"18#include <unordered_map>19 20namespace Fortran::semantics {21 22// TODO: C1234, C1235 -- defined I/O constraints23 24class FormatErrorReporter {25public:26 FormatErrorReporter(SemanticsContext &context,27 const parser::CharBlock &formatCharBlock, int errorAllowance = 3)28 : context_{context}, formatCharBlock_{formatCharBlock},29 errorAllowance_{errorAllowance} {}30 31 bool Say(const common::FormatMessage &);32 33private:34 SemanticsContext &context_;35 const parser::CharBlock &formatCharBlock_;36 int errorAllowance_; // initialized to maximum number of errors to report37};38 39bool FormatErrorReporter::Say(const common::FormatMessage &msg) {40 if (!msg.isError &&41 !context_.ShouldWarn(common::LanguageFeature::AdditionalFormats)) {42 return false;43 }44 parser::MessageFormattedText text{45 parser::MessageFixedText{msg.text, strlen(msg.text),46 msg.isError ? parser::Severity::Error : parser::Severity::Warning},47 msg.arg};48 if (formatCharBlock_.size()) {49 // The input format is a folded expression. Error markers span the full50 // original unfolded expression in formatCharBlock_.51 context_.Say(formatCharBlock_, text);52 } else {53 // The input format is a source expression. Error markers have an offset54 // and length relative to the beginning of formatCharBlock_.55 parser::CharBlock messageCharBlock{56 parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)};57 context_.Say(messageCharBlock, text);58 }59 return msg.isError && --errorAllowance_ <= 0;60}61 62void IoChecker::Enter(63 const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) {64 if (!stmt.label) {65 context_.Say("Format statement must be labeled"_err_en_US); // C130166 }67 const char *formatStart{static_cast<const char *>(68 std::memchr(stmt.source.begin(), '(', stmt.source.size()))};69 parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)};70 FormatErrorReporter reporter{context_, reporterCharBlock};71 auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }};72 switch (context_.GetDefaultKind(TypeCategory::Character)) {73 case 1: {74 common::FormatValidator<char> validator{formatStart,75 stmt.source.size() - (formatStart - stmt.source.begin()),76 reporterWrapper};77 validator.Check();78 break;79 }80 case 2: { // TODO: Get this to work.81 common::FormatValidator<char16_t> validator{82 /*???*/ nullptr, /*???*/ 0, reporterWrapper};83 validator.Check();84 break;85 }86 case 4: { // TODO: Get this to work.87 common::FormatValidator<char32_t> validator{88 /*???*/ nullptr, /*???*/ 0, reporterWrapper};89 validator.Check();90 break;91 }92 default:93 CRASH_NO_CASE;94 }95}96 97void IoChecker::Enter(const parser::ConnectSpec &spec) {98 // ConnectSpec context FileNameExpr99 if (std::get_if<parser::FileNameExpr>(&spec.u)) {100 SetSpecifier(IoSpecKind::File);101 }102}103 104// Ignore trailing spaces (12.5.6.2 p1) and convert to upper case105static std::string Normalize(const std::string &value) {106 auto upper{parser::ToUpperCaseLetters(value)};107 std::size_t lastNonBlank{upper.find_last_not_of(' ')};108 upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1);109 return upper;110}111 112void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {113 IoSpecKind specKind{};114 using ParseKind = parser::ConnectSpec::CharExpr::Kind;115 switch (std::get<ParseKind>(spec.t)) {116 case ParseKind::Access:117 specKind = IoSpecKind::Access;118 break;119 case ParseKind::Action:120 specKind = IoSpecKind::Action;121 break;122 case ParseKind::Asynchronous:123 specKind = IoSpecKind::Asynchronous;124 break;125 case ParseKind::Blank:126 specKind = IoSpecKind::Blank;127 break;128 case ParseKind::Decimal:129 specKind = IoSpecKind::Decimal;130 break;131 case ParseKind::Delim:132 specKind = IoSpecKind::Delim;133 break;134 case ParseKind::Encoding:135 specKind = IoSpecKind::Encoding;136 break;137 case ParseKind::Form:138 specKind = IoSpecKind::Form;139 break;140 case ParseKind::Pad:141 specKind = IoSpecKind::Pad;142 break;143 case ParseKind::Position:144 specKind = IoSpecKind::Position;145 break;146 case ParseKind::Round:147 specKind = IoSpecKind::Round;148 break;149 case ParseKind::Sign:150 specKind = IoSpecKind::Sign;151 break;152 case ParseKind::Carriagecontrol:153 specKind = IoSpecKind::Carriagecontrol;154 break;155 case ParseKind::Convert:156 specKind = IoSpecKind::Convert;157 break;158 case ParseKind::Dispose:159 specKind = IoSpecKind::Dispose;160 break;161 }162 SetSpecifier(specKind);163 if (const std::optional<std::string> charConst{GetConstExpr<std::string>(164 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {165 std::string s{Normalize(*charConst)};166 if (specKind == IoSpecKind::Access) {167 flags_.set(Flag::KnownAccess);168 flags_.set(Flag::AccessDirect, s == "DIRECT");169 flags_.set(Flag::AccessStream, s == "STREAM");170 }171 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));172 if (specKind == IoSpecKind::Carriagecontrol &&173 (s == "FORTRAN" || s == "NONE")) {174 context_.Say(parser::FindSourceLocation(spec),175 "Unimplemented %s value '%s'"_err_en_US,176 parser::ToUpperCaseLetters(common::EnumToString(specKind)),177 *charConst);178 }179 }180}181 182void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {183 CheckForDefinableVariable(var, "NEWUNIT");184 SetSpecifier(IoSpecKind::Newunit);185}186 187void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) {188 SetSpecifier(IoSpecKind::Recl);189 if (const std::optional<std::int64_t> recl{190 GetConstExpr<std::int64_t>(spec)}) {191 if (*recl <= 0) {192 context_.Say(parser::FindSourceLocation(spec),193 "RECL value (%jd) must be positive"_err_en_US,194 *recl); // 12.5.6.15195 }196 }197}198 199void IoChecker::Enter(const parser::EndLabel &) {200 SetSpecifier(IoSpecKind::End);201}202 203void IoChecker::Enter(const parser::EorLabel &) {204 SetSpecifier(IoSpecKind::Eor);205}206 207void IoChecker::Enter(const parser::ErrLabel &) {208 SetSpecifier(IoSpecKind::Err);209}210 211void IoChecker::Enter(const parser::FileUnitNumber &) {212 SetSpecifier(IoSpecKind::Unit);213 flags_.set(Flag::NumberUnit);214}215 216void IoChecker::Enter(const parser::Format &spec) {217 SetSpecifier(IoSpecKind::Fmt);218 flags_.set(Flag::FmtOrNml);219 common::visit(220 common::visitors{221 [&](const parser::Label &) { flags_.set(Flag::LabelFmt); },222 [&](const parser::Star &) { flags_.set(Flag::StarFmt); },223 [&](const parser::Expr &format) {224 const SomeExpr *expr{GetExpr(context_, format)};225 if (!expr) {226 return;227 }228 auto type{expr->GetType()};229 if (type && type->category() == TypeCategory::Integer &&230 type->kind() ==231 context_.defaultKinds().GetDefaultKind(type->category()) &&232 expr->Rank() == 0) {233 flags_.set(Flag::AssignFmt);234 if (!IsVariable(*expr)) {235 context_.Say(format.source,236 "Assigned format label must be a scalar variable"_err_en_US);237 } else {238 context_.Warn(common::LanguageFeature::Assign, format.source,239 "Assigned format labels are deprecated"_port_en_US);240 }241 return;242 }243 if (type && type->category() != TypeCategory::Character &&244 (type->category() != TypeCategory::Integer ||245 expr->Rank() > 0) &&246 context_.IsEnabled(247 common::LanguageFeature::NonCharacterFormat)) {248 // Legacy extension: using non-character variables, typically249 // DATA-initialized with Hollerith, as format expressions.250 context_.Warn(common::LanguageFeature::NonCharacterFormat,251 format.source,252 "Non-character format expression is not standard"_port_en_US);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.2267 bool isFolded{constantFormat->size() != format.source.size() - 2};268 parser::CharBlock reporterCharBlock{isFolded269 ? 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)); // C1229319 }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::ReadFormatted332 : common::DefinedIo::ReadUnformatted,333 var->GetSource());334 }335}336 337void IoChecker::Enter(const parser::InquireSpec &spec) {338 // InquireSpec context FileNameExpr339 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 auto &var{parser::UnwrapRef<parser::Variable>(428 std::get<parser::ScalarDefaultCharVariable>(spec.t))};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 CheckForDefinableVariable(std::get<parser::ScalarLogicalVariable>(spec.t),482 parser::ToUpperCaseLetters(common::EnumToString(specKind)));483 SetSpecifier(specKind);484}485 486void IoChecker::Enter(const parser::IoControlSpec &spec) {487 // IoControlSpec context Name488 flags_.set(Flag::IoControlList);489 if (std::holds_alternative<parser::Name>(spec.u)) {490 SetSpecifier(IoSpecKind::Nml);491 flags_.set(Flag::FmtOrNml);492 }493}494 495void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) {496 SetSpecifier(IoSpecKind::Asynchronous);497 if (const std::optional<std::string> charConst{498 GetConstExpr<std::string>(spec)}) {499 flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES");500 CheckStringValue(IoSpecKind::Asynchronous, *charConst,501 parser::FindSourceLocation(spec)); // C1223502 }503}504 505void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {506 IoSpecKind specKind{};507 using ParseKind = parser::IoControlSpec::CharExpr::Kind;508 switch (std::get<ParseKind>(spec.t)) {509 case ParseKind::Advance:510 specKind = IoSpecKind::Advance;511 break;512 case ParseKind::Blank:513 specKind = IoSpecKind::Blank;514 break;515 case ParseKind::Decimal:516 specKind = IoSpecKind::Decimal;517 break;518 case ParseKind::Delim:519 specKind = IoSpecKind::Delim;520 break;521 case ParseKind::Pad:522 specKind = IoSpecKind::Pad;523 break;524 case ParseKind::Round:525 specKind = IoSpecKind::Round;526 break;527 case ParseKind::Sign:528 specKind = IoSpecKind::Sign;529 break;530 }531 SetSpecifier(specKind);532 if (const std::optional<std::string> charConst{GetConstExpr<std::string>(533 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {534 if (specKind == IoSpecKind::Advance) {535 flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES");536 }537 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));538 }539}540 541void IoChecker::Enter(const parser::IoControlSpec::Pos &) {542 SetSpecifier(IoSpecKind::Pos);543}544 545void IoChecker::Enter(const parser::IoControlSpec::Rec &) {546 SetSpecifier(IoSpecKind::Rec);547}548 549void IoChecker::Enter(const parser::IoControlSpec::Size &var) {550 CheckForDefinableVariable(var, "SIZE");551 SetSpecifier(IoSpecKind::Size);552}553 554void IoChecker::Enter(const parser::IoUnit &spec) {555 if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {556 // Only now after generic resolution can it be known whether a function557 // call appearing as UNIT=f() is an integer scalar external unit number558 // or a character pointer for internal I/O.559 const auto *expr{GetExpr(context_, *var)};560 std::optional<evaluate::DynamicType> dyType;561 if (expr) {562 dyType = expr->GetType();563 }564 if (dyType && dyType->category() == TypeCategory::Integer) {565 if (expr->Rank() != 0) {566 context_.Say(parser::FindSourceLocation(*var),567 "I/O unit number must be scalar"_err_en_US);568 }569 // In the case of an integer unit number variable, rewrite the parse570 // tree as if the unit had been parsed as a FileUnitNumber in order571 // to ease lowering.572 auto &mutableSpec{const_cast<parser::IoUnit &>(spec)};573 auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)};574 auto source{mutableVar.GetSource()};575 auto typedExpr{std::move(mutableVar.typedExpr)};576 auto newExpr{common::visit(577 [](auto &&indirection) {578 return parser::Expr{std::move(indirection)};579 },580 std::move(mutableVar.u))};581 newExpr.source = source;582 newExpr.typedExpr = std::move(typedExpr);583 mutableSpec.u = common::Indirection<parser::Expr>{std::move(newExpr)};584 SetSpecifier(IoSpecKind::Unit);585 flags_.set(Flag::NumberUnit);586 } else if (!dyType || dyType->category() != TypeCategory::Character) {587 SetSpecifier(IoSpecKind::Unit);588 context_.Say(parser::FindSourceLocation(*var),589 "I/O unit must be a character variable or a scalar integer expression"_err_en_US);590 } else { // CHARACTER variable (internal I/O)591 if (stmt_ == IoStmtKind::Write) {592 CheckForDefinableVariable(*var, "Internal file");593 WarnOnDeferredLengthCharacterScalar(594 context_, expr, var->GetSource(), "Internal file");595 }596 if (HasVectorSubscript(*expr)) {597 context_.Say(parser::FindSourceLocation(*var), // C1201598 "Internal file must not have a vector subscript"_err_en_US);599 }600 SetSpecifier(IoSpecKind::Unit);601 flags_.set(Flag::InternalUnit);602 }603 } else if (std::get_if<parser::Star>(&spec.u)) {604 SetSpecifier(IoSpecKind::Unit);605 flags_.set(Flag::StarUnit);606 } else if (const common::Indirection<parser::Expr> *pexpr{607 std::get_if<common::Indirection<parser::Expr>>(&spec.u)}) {608 const auto *expr{GetExpr(context_, *pexpr)};609 std::optional<evaluate::DynamicType> dyType;610 if (expr) {611 dyType = expr->GetType();612 }613 if (!expr || !dyType) {614 context_.Say(parser::FindSourceLocation(*pexpr),615 "I/O unit must be a character variable or scalar integer expression"_err_en_US);616 } else if (dyType->category() != TypeCategory::Integer) {617 context_.Say(parser::FindSourceLocation(*pexpr),618 "I/O unit must be a character variable or a scalar integer expression, but is an expression of type %s"_err_en_US,619 parser::ToUpperCaseLetters(dyType->AsFortran()));620 } else if (expr->Rank() != 0) {621 context_.Say(parser::FindSourceLocation(*pexpr),622 "I/O unit number must be scalar"_err_en_US);623 }624 SetSpecifier(IoSpecKind::Unit);625 flags_.set(Flag::NumberUnit);626 }627}628 629void IoChecker::Enter(const parser::MsgVariable &msgVar) {630 const auto &var{parser::UnwrapRef<parser::Variable>(msgVar)};631 if (stmt_ == IoStmtKind::None) {632 // allocate, deallocate, image control633 CheckForDefinableVariable(var, "ERRMSG");634 WarnOnDeferredLengthCharacterScalar(635 context_, GetExpr(context_, var), var.GetSource(), "ERRMSG=");636 } else {637 CheckForDefinableVariable(var, "IOMSG");638 WarnOnDeferredLengthCharacterScalar(639 context_, GetExpr(context_, var), var.GetSource(), "IOMSG=");640 SetSpecifier(IoSpecKind::Iomsg);641 }642}643 644void IoChecker::Enter(const parser::OutputItem &item) {645 flags_.set(Flag::DataList);646 if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {647 if (const auto *expr{GetExpr(context_, *x)}) {648 if (evaluate::IsBOZLiteral(*expr)) {649 context_.Say(parser::FindSourceLocation(*x), // C7109650 "Output item must not be a BOZ literal constant"_err_en_US);651 } else if (IsProcedure(*expr)) {652 context_.Say(parser::FindSourceLocation(*x),653 "Output item must not be a procedure"_err_en_US); // C1233654 }655 CheckForBadIoType(*expr,656 flags_.test(Flag::FmtOrNml) ? common::DefinedIo::WriteFormatted657 : common::DefinedIo::WriteUnformatted,658 parser::FindSourceLocation(item));659 }660 }661}662 663void IoChecker::Enter(const parser::StatusExpr &spec) {664 SetSpecifier(IoSpecKind::Status);665 if (const std::optional<std::string> charConst{666 GetConstExpr<std::string>(spec)}) {667 // Status values for Open and Close are different.668 std::string s{Normalize(*charConst)};669 if (stmt_ == IoStmtKind::Open) {670 flags_.set(Flag::KnownStatus);671 flags_.set(Flag::StatusNew, s == "NEW");672 flags_.set(Flag::StatusReplace, s == "REPLACE");673 flags_.set(Flag::StatusScratch, s == "SCRATCH");674 // CheckStringValue compares for OPEN Status string values.675 CheckStringValue(676 IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec));677 return;678 }679 CHECK(stmt_ == IoStmtKind::Close);680 if (s != "DELETE" && s != "KEEP") {681 context_.Say(parser::FindSourceLocation(spec),682 "Invalid STATUS value '%s'"_err_en_US, *charConst);683 }684 }685}686 687void IoChecker::Enter(const parser::StatVariable &var) {688 if (stmt_ == IoStmtKind::None) {689 // allocate, deallocate, image control690 CheckForDefinableVariable(var, "STAT");691 } else {692 CheckForDefinableVariable(var, "IOSTAT");693 SetSpecifier(IoSpecKind::Iostat);694 }695}696 697void IoChecker::Leave(const parser::BackspaceStmt &) {698 CheckForPureSubprogram();699 CheckForRequiredSpecifier(700 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240701 CheckForUselessIomsg();702 Done();703}704 705void IoChecker::Leave(const parser::CloseStmt &) {706 CheckForPureSubprogram();707 CheckForRequiredSpecifier(708 flags_.test(Flag::NumberUnit), "UNIT number"); // C1208709 CheckForUselessIomsg();710 Done();711}712 713void IoChecker::Leave(const parser::EndfileStmt &) {714 CheckForPureSubprogram();715 CheckForRequiredSpecifier(716 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240717 CheckForUselessIomsg();718 Done();719}720 721void IoChecker::Leave(const parser::FlushStmt &) {722 CheckForPureSubprogram();723 CheckForRequiredSpecifier(724 flags_.test(Flag::NumberUnit), "UNIT number"); // C1243725 CheckForUselessIomsg();726 Done();727}728 729void IoChecker::Leave(const parser::InquireStmt &stmt) {730 if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {731 CheckForPureSubprogram();732 // Inquire by unit or by file (vs. by output list).733 CheckForRequiredSpecifier(734 flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File),735 "UNIT number or FILE"); // C1246736 CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246737 CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248738 CheckForUselessIomsg();739 }740 Done();741}742 743void IoChecker::Leave(const parser::OpenStmt &) {744 CheckForPureSubprogram();745 CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) ||746 specifierSet_.test(IoSpecKind::Newunit),747 "UNIT or NEWUNIT"); // C1204, C1205748 CheckForProhibitedSpecifier(749 IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205750 CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'",751 IoSpecKind::File); // 12.5.6.10752 CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace),753 "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10754 CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch),755 "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10756 if (flags_.test(Flag::KnownStatus)) {757 CheckForRequiredSpecifier(IoSpecKind::Newunit,758 specifierSet_.test(IoSpecKind::File) ||759 flags_.test(Flag::StatusScratch),760 "FILE or STATUS='SCRATCH'"); // 12.5.6.12761 } else {762 CheckForRequiredSpecifier(IoSpecKind::Newunit,763 specifierSet_.test(IoSpecKind::File) ||764 specifierSet_.test(IoSpecKind::Status),765 "FILE or STATUS"); // 12.5.6.12766 }767 if (flags_.test(Flag::KnownAccess)) {768 CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect),769 "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15770 CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),771 "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15772 }773 CheckForUselessIomsg();774 Done();775}776 777void IoChecker::Leave(const parser::PrintStmt &) {778 CheckForPureSubprogram();779 CheckForUselessIomsg();780 Done();781}782 783static const parser::Name *FindNamelist(784 const std::list<parser::IoControlSpec> &controls) {785 for (const auto &control : controls) {786 if (const parser::Name * namelist{std::get_if<parser::Name>(&control.u)}) {787 if (namelist->symbol &&788 namelist->symbol->GetUltimate().has<NamelistDetails>()) {789 return namelist;790 }791 }792 }793 return nullptr;794}795 796static void CheckForDoVariable(797 const parser::ReadStmt &readStmt, SemanticsContext &context) {798 const std::list<parser::InputItem> &items{readStmt.items};799 for (const auto &item : items) {800 if (const parser::Variable *801 variable{std::get_if<parser::Variable>(&item.u)}) {802 context.CheckIndexVarRedefine(*variable);803 }804 }805}806 807void IoChecker::Leave(const parser::ReadStmt &readStmt) {808 if (!flags_.test(Flag::InternalUnit)) {809 CheckForPureSubprogram();810 }811 if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) {812 if (namelist->symbol) {813 CheckNamelist(*namelist->symbol, common::DefinedIo::ReadFormatted,814 namelist->source);815 }816 }817 CheckForDoVariable(readStmt, context_);818 if (!flags_.test(Flag::IoControlList)) {819 Done();820 return;821 }822 LeaveReadWrite();823 CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212824 CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212825 CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220826 if (specifierSet_.test(IoSpecKind::Size)) {827 // F'2023 C1214 - allow with a warning828 if (context_.ShouldWarn(common::LanguageFeature::ListDirectedSize)) {829 if (specifierSet_.test(IoSpecKind::Nml)) {830 context_.Say("If NML appears, SIZE should not appear"_port_en_US);831 } else if (flags_.test(Flag::StarFmt)) {832 context_.Say("If FMT=* appears, SIZE should not appear"_port_en_US);833 }834 }835 }836 CheckForRequiredSpecifier(IoSpecKind::Eor,837 specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes),838 "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2839 CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml),840 "FMT or NML"); // C1227841 CheckForRequiredSpecifier(842 IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227843 Done();844}845 846void IoChecker::Leave(const parser::RewindStmt &) {847 CheckForRequiredSpecifier(848 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240849 CheckForPureSubprogram();850 CheckForUselessIomsg();851 Done();852}853 854void IoChecker::Leave(const parser::WaitStmt &) {855 CheckForRequiredSpecifier(856 flags_.test(Flag::NumberUnit), "UNIT number"); // C1237857 CheckForPureSubprogram();858 CheckForUselessIomsg();859 Done();860}861 862void IoChecker::Leave(const parser::WriteStmt &writeStmt) {863 if (!flags_.test(Flag::InternalUnit)) {864 CheckForPureSubprogram();865 }866 if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) {867 if (namelist->symbol) {868 CheckNamelist(*namelist->symbol, common::DefinedIo::WriteFormatted,869 namelist->source);870 }871 }872 LeaveReadWrite();873 CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213874 CheckForProhibitedSpecifier(IoSpecKind::End); // C1213875 CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213876 CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213877 CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213878 CheckForRequiredSpecifier(879 IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227880 CheckForRequiredSpecifier(IoSpecKind::Delim,881 flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),882 "FMT=* or NML"); // C1228883 Done();884}885 886void IoChecker::LeaveReadWrite() const {887 CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211888 CheckForRequiredSpecifier(flags_.test(Flag::InternalUnit),889 "UNIT=internal-file", flags_.test(Flag::FmtOrNml), "FMT or NML");890 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216891 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216892 CheckForProhibitedSpecifier(893 IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216894 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),895 "UNIT=internal-file", IoSpecKind::Pos); // C1219896 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),897 "UNIT=internal-file", IoSpecKind::Rec); // C1219898 CheckForProhibitedSpecifier(899 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219900 CheckForProhibitedSpecifier(901 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219902 CheckForProhibitedSpecifier(903 IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220904 CheckForRequiredSpecifier(IoSpecKind::Advance,905 flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) ||906 flags_.test(Flag::AssignFmt),907 "an explicit format"); // C1221908 CheckForProhibitedSpecifier(IoSpecKind::Advance,909 flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221910 CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes),911 "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit),912 "UNIT=number"); // C1224913 CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes),914 "ASYNCHRONOUS='YES'"); // C1225915 CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226916 CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml),917 "FMT or NML"); // C1227918 CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml),919 "FMT or NML"); // C1227920 CheckForUselessIomsg();921}922 923void IoChecker::SetSpecifier(IoSpecKind specKind) {924 if (stmt_ == IoStmtKind::None) {925 // FMT may appear on PRINT statements, which don't have any checks.926 // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements.927 return;928 }929 // C1203, C1207, C1210, C1236, C1239, C1242, C1245930 if (specifierSet_.test(specKind)) {931 context_.Say("Duplicate %s specifier"_err_en_US,932 parser::ToUpperCaseLetters(common::EnumToString(specKind)));933 }934 specifierSet_.set(specKind);935}936 937void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,938 const parser::CharBlock &source) const {939 static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{940 {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}},941 {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}},942 {IoSpecKind::Advance, {"NO", "YES"}},943 {IoSpecKind::Asynchronous, {"NO", "YES"}},944 {IoSpecKind::Blank, {"NULL", "ZERO"}},945 {IoSpecKind::Decimal, {"COMMA", "POINT"}},946 {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}},947 {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}},948 {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED", "BINARY"}},949 {IoSpecKind::Pad, {"NO", "YES"}},950 {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}},951 {IoSpecKind::Round,952 {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},953 {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},954 {IoSpecKind::Status,955 // Open values; Close values are {"DELETE", "KEEP"}.956 {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},957 {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},958 {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE", "SWAP"}},959 {IoSpecKind::Dispose, {"DELETE", "KEEP"}},960 };961 auto upper{Normalize(value)};962 if (specValues.at(specKind).count(upper) == 0) {963 if (specKind == IoSpecKind::Access && upper == "APPEND") {964 context_.Warn(common::LanguageFeature::OpenAccessAppend, source,965 "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, upper);966 } else {967 context_.Say(source, "Invalid %s value '%s'"_err_en_US,968 parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);969 }970 }971}972 973// CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions974// need conditions to check, and string arguments to insert into a message.975// An IoSpecKind provides both an absence/presence condition and a string976// argument (its name). A (condition, string) pair provides an arbitrary977// condition and an arbitrary string.978 979void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {980 if (!specifierSet_.test(specKind)) {981 context_.Say("%s statement must have a %s specifier"_err_en_US,982 parser::ToUpperCaseLetters(common::EnumToString(stmt_)),983 parser::ToUpperCaseLetters(common::EnumToString(specKind)));984 }985}986 987void IoChecker::CheckForRequiredSpecifier(988 bool condition, const std::string &s) const {989 if (!condition) {990 context_.Say("%s statement must have a %s specifier"_err_en_US,991 parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);992 }993}994 995void IoChecker::CheckForRequiredSpecifier(996 IoSpecKind specKind1, IoSpecKind specKind2) const {997 if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {998 context_.Say("If %s appears, %s must also appear"_err_en_US,999 parser::ToUpperCaseLetters(common::EnumToString(specKind1)),1000 parser::ToUpperCaseLetters(common::EnumToString(specKind2)));1001 }1002}1003 1004void IoChecker::CheckForRequiredSpecifier(1005 IoSpecKind specKind, bool condition, const std::string &s) const {1006 if (specifierSet_.test(specKind) && !condition) {1007 context_.Say("If %s appears, %s must also appear"_err_en_US,1008 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);1009 }1010}1011 1012void IoChecker::CheckForRequiredSpecifier(1013 bool condition, const std::string &s, IoSpecKind specKind) const {1014 if (condition && !specifierSet_.test(specKind)) {1015 context_.Say("If %s appears, %s must also appear"_err_en_US, s,1016 parser::ToUpperCaseLetters(common::EnumToString(specKind)));1017 }1018}1019 1020void IoChecker::CheckForRequiredSpecifier(bool condition1,1021 const std::string &s1, bool condition2, const std::string &s2) const {1022 if (condition1 && !condition2) {1023 context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);1024 }1025}1026 1027void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {1028 if (specifierSet_.test(specKind)) {1029 context_.Say("%s statement must not have a %s specifier"_err_en_US,1030 parser::ToUpperCaseLetters(common::EnumToString(stmt_)),1031 parser::ToUpperCaseLetters(common::EnumToString(specKind)));1032 }1033}1034 1035void IoChecker::CheckForProhibitedSpecifier(1036 IoSpecKind specKind1, IoSpecKind specKind2) const {1037 if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {1038 context_.Say("If %s appears, %s must not appear"_err_en_US,1039 parser::ToUpperCaseLetters(common::EnumToString(specKind1)),1040 parser::ToUpperCaseLetters(common::EnumToString(specKind2)));1041 }1042}1043 1044void IoChecker::CheckForProhibitedSpecifier(1045 IoSpecKind specKind, bool condition, const std::string &s) const {1046 if (specifierSet_.test(specKind) && condition) {1047 context_.Say("If %s appears, %s must not appear"_err_en_US,1048 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);1049 }1050}1051 1052void IoChecker::CheckForProhibitedSpecifier(1053 bool condition, const std::string &s, IoSpecKind specKind) const {1054 if (condition && specifierSet_.test(specKind)) {1055 context_.Say("If %s appears, %s must not appear"_err_en_US, s,1056 parser::ToUpperCaseLetters(common::EnumToString(specKind)));1057 }1058}1059 1060template <typename A>1061void IoChecker::CheckForDefinableVariable(1062 const A &variable, const std::string &s) const {1063 if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {1064 if (auto expr{AnalyzeExpr(context_, *var)}) {1065 auto at{var->GetSource()};1066 if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),1067 DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},1068 *expr)}) {1069 if (whyNot->IsFatal()) {1070 const Symbol *base{GetFirstSymbol(*expr)};1071 context_1072 .Say(at, "%s variable '%s' is not definable"_err_en_US, s,1073 (base ? base->name() : at).ToString())1074 .Attach(1075 std::move(whyNot->set_severity(parser::Severity::Because)));1076 } else {1077 context_.Say(std::move(*whyNot));1078 }1079 }1080 }1081 }1082}1083 1084void IoChecker::CheckForPureSubprogram() const { // C15971085 CHECK(context_.location());1086 const Scope &scope{context_.FindScope(*context_.location())};1087 if (FindPureProcedureContaining(scope)) {1088 context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US);1089 }1090}1091 1092void IoChecker::CheckForUselessIomsg() const {1093 if (specifierSet_.test(IoSpecKind::Iomsg) &&1094 !specifierSet_.test(IoSpecKind::Err) &&1095 !specifierSet_.test(IoSpecKind::Iostat) &&1096 context_.ShouldWarn(common::UsageWarning::UselessIomsg)) {1097 context_.Say("IOMSG= is useless without either ERR= or IOSTAT="_warn_en_US);1098 }1099}1100 1101// Seeks out an allocatable or pointer ultimate component that is not1102// nested in a nonallocatable/nonpointer component with a specific1103// defined I/O procedure.1104static const Symbol *FindUnsafeIoDirectComponent(common::DefinedIo which,1105 const DerivedTypeSpec &derived, const Scope &scope) {1106 if (HasDefinedIo(which, derived, &scope)) {1107 return nullptr;1108 }1109 if (const Scope * dtScope{derived.scope()}) {1110 for (const auto &pair : *dtScope) {1111 const Symbol &symbol{*pair.second};1112 if (IsAllocatableOrPointer(symbol)) {1113 return &symbol;1114 }1115 if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {1116 if (const DeclTypeSpec * type{details->type()}) {1117 if (type->category() == DeclTypeSpec::Category::TypeDerived) {1118 const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()};1119 if (const Symbol *1120 bad{FindUnsafeIoDirectComponent(1121 which, componentDerived, scope)}) {1122 return bad;1123 }1124 }1125 }1126 }1127 }1128 }1129 return nullptr;1130}1131 1132// For a type that does not have a defined I/O subroutine, finds a direct1133// component that is a witness to an accessibility violation outside the module1134// in which the type was defined.1135static const Symbol *FindInaccessibleComponent(common::DefinedIo which,1136 const DerivedTypeSpec &derived, const Scope &scope) {1137 if (const Scope * dtScope{derived.scope()}) {1138 if (const Scope * module{FindModuleContaining(*dtScope)}) {1139 for (const auto &pair : *dtScope) {1140 const Symbol &symbol{*pair.second};1141 if (IsAllocatableOrPointer(symbol)) {1142 continue; // already an error1143 }1144 if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {1145 const DerivedTypeSpec *componentDerived{nullptr};1146 if (const DeclTypeSpec * type{details->type()}) {1147 if (type->category() == DeclTypeSpec::Category::TypeDerived) {1148 componentDerived = &type->derivedTypeSpec();1149 }1150 }1151 if (componentDerived &&1152 HasDefinedIo(which, *componentDerived, &scope)) {1153 continue; // this component and its descendents are fine1154 }1155 if (symbol.attrs().test(Attr::PRIVATE) &&1156 !symbol.test(Symbol::Flag::ParentComp)) {1157 if (!DoesScopeContain(module, scope)) {1158 return &symbol;1159 }1160 }1161 if (componentDerived) {1162 if (const Symbol *1163 bad{FindInaccessibleComponent(1164 which, *componentDerived, scope)}) {1165 return bad;1166 }1167 }1168 }1169 }1170 }1171 }1172 return nullptr;1173}1174 1175// Fortran 2018, 12.6.3 paragraphs 5 & 71176parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type,1177 common::DefinedIo which, parser::CharBlock where) const {1178 if (type.IsUnlimitedPolymorphic()) {1179 return &context_.Say(1180 where, "I/O list item may not be unlimited polymorphic"_err_en_US);1181 } else if (type.category() == TypeCategory::Derived) {1182 const auto &derived{type.GetDerivedTypeSpec()};1183 const Scope &scope{context_.FindScope(where)};1184 if (const Symbol *1185 bad{FindUnsafeIoDirectComponent(which, derived, scope)}) {1186 return &context_.SayWithDecl(*bad, where,1187 "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US,1188 derived.name(), bad->name());1189 }1190 if (!HasDefinedIo(which, derived, &scope)) {1191 if (type.IsPolymorphic()) {1192 return &context_.Say(where,1193 "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US,1194 derived.name());1195 }1196 if ((IsBuiltinDerivedType(&derived, "c_ptr") ||1197 IsBuiltinDerivedType(&derived, "c_devptr")) &&1198 !context_.ShouldWarn(common::LanguageFeature::PrintCptr)) {1199 // Bypass the check below for c_ptr and c_devptr.1200 return nullptr;1201 }1202 if (const Symbol *1203 bad{FindInaccessibleComponent(which, derived, scope)}) {1204 return &context_.Say(where,1205 "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,1206 derived.name(), bad->name());1207 }1208 }1209 }1210 return nullptr;1211}1212 1213void IoChecker::CheckForBadIoType(const SomeExpr &expr, common::DefinedIo which,1214 parser::CharBlock where) const {1215 if (auto type{expr.GetType()}) {1216 CheckForBadIoType(*type, which, where);1217 }1218}1219 1220parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol,1221 common::DefinedIo which, parser::CharBlock where) const {1222 if (auto type{evaluate::DynamicType::From(symbol)}) {1223 if (auto *msg{CheckForBadIoType(*type, which, where)}) {1224 evaluate::AttachDeclaration(*msg, symbol);1225 return msg;1226 }1227 }1228 return nullptr;1229}1230 1231void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,1232 parser::CharBlock namelistLocation) const {1233 if (!context_.HasError(namelist)) {1234 const auto &details{namelist.GetUltimate().get<NamelistDetails>()};1235 for (const Symbol &object : details.objects()) {1236 context_.CheckIndexVarRedefine(namelistLocation, object);1237 if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {1238 evaluate::AttachDeclaration(*msg, namelist);1239 } else if (which == common::DefinedIo::ReadFormatted) {1240 if (auto why{WhyNotDefinable(namelistLocation, namelist.owner(),1241 DefinabilityFlags{}, object)}) {1242 context_1243 .Say(namelistLocation,1244 "NAMELIST input group must not contain undefinable item '%s'"_err_en_US,1245 object.name())1246 .Attach(std::move(why->set_severity(parser::Severity::Because)));1247 context_.SetError(namelist);1248 }1249 }1250 }1251 }1252}1253 1254} // namespace Fortran::semantics1255