1212 lines · cpp
1//===-- lib/Semantics/check-do-forall.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-do-forall.h"10#include "definable.h"11#include "flang/Common/template.h"12#include "flang/Evaluate/call.h"13#include "flang/Evaluate/expression.h"14#include "flang/Evaluate/tools.h"15#include "flang/Evaluate/traverse.h"16#include "flang/Parser/message.h"17#include "flang/Parser/parse-tree-visitor.h"18#include "flang/Parser/tools.h"19#include "flang/Semantics/attr.h"20#include "flang/Semantics/scope.h"21#include "flang/Semantics/semantics.h"22#include "flang/Semantics/symbol.h"23#include "flang/Semantics/tools.h"24#include "flang/Semantics/type.h"25 26namespace Fortran::evaluate {27using ActualArgumentRef = common::Reference<const ActualArgument>;28 29inline bool operator<(ActualArgumentRef x, ActualArgumentRef y) {30 return &*x < &*y;31}32} // namespace Fortran::evaluate33 34namespace Fortran::semantics {35 36using namespace parser::literals;37 38using Bounds = parser::LoopControl::Bounds;39using IndexVarKind = SemanticsContext::IndexVarKind;40 41static const parser::ConcurrentHeader &GetConcurrentHeader(42 const parser::LoopControl &loopControl) {43 const auto &concurrent{44 std::get<parser::LoopControl::Concurrent>(loopControl.u)};45 return std::get<parser::ConcurrentHeader>(concurrent.t);46}47static const parser::ConcurrentHeader &GetConcurrentHeader(48 const parser::ForallConstruct &construct) {49 const auto &stmt{50 std::get<parser::Statement<parser::ForallConstructStmt>>(construct.t)};51 return std::get<common::Indirection<parser::ConcurrentHeader>>(52 stmt.statement.t)53 .value();54}55static const parser::ConcurrentHeader &GetConcurrentHeader(56 const parser::ForallStmt &stmt) {57 return std::get<common::Indirection<parser::ConcurrentHeader>>(stmt.t)58 .value();59}60template <typename T>61static const std::list<parser::ConcurrentControl> &GetControls(const T &x) {62 return std::get<std::list<parser::ConcurrentControl>>(63 GetConcurrentHeader(x).t);64}65 66static const Bounds &GetBounds(const parser::DoConstruct &doConstruct) {67 auto &loopControl{doConstruct.GetLoopControl().value()};68 return std::get<Bounds>(loopControl.u);69}70 71static const parser::Name &GetDoVariable(72 const parser::DoConstruct &doConstruct) {73 const Bounds &bounds{GetBounds(doConstruct)};74 return bounds.name.thing;75}76 77static parser::MessageFixedText GetEnclosingDoMsg() {78 return "Enclosing DO CONCURRENT statement"_en_US;79}80 81static void SayWithDo(SemanticsContext &context, parser::CharBlock stmtLocation,82 parser::MessageFixedText &&message, parser::CharBlock doLocation) {83 context.Say(stmtLocation, message).Attach(doLocation, GetEnclosingDoMsg());84}85 86// 11.1.7.5 - enforce semantics constraints on a DO CONCURRENT loop body87class DoConcurrentBodyEnforce {88public:89 DoConcurrentBodyEnforce(90 SemanticsContext &context, parser::CharBlock doConcurrentSourcePosition)91 : context_{context},92 doConcurrentSourcePosition_{doConcurrentSourcePosition} {}93 std::set<parser::Label> labels() { return labels_; }94 template <typename T> bool Pre(const T &x) {95 if (const auto *expr{GetExpr(context_, x)}) {96 if (auto bad{FindImpureCall(context_.foldingContext(), *expr)}) {97 context_.Say(currentStatementSourcePosition_,98 "Impure procedure '%s' may not be referenced in DO CONCURRENT"_err_en_US,99 *bad);100 }101 }102 return true;103 }104 template <typename T> bool Pre(const parser::Statement<T> &statement) {105 currentStatementSourcePosition_ = statement.source;106 if (statement.label.has_value()) {107 labels_.insert(*statement.label);108 }109 return true;110 }111 template <typename T> bool Pre(const parser::UnlabeledStatement<T> &stmt) {112 currentStatementSourcePosition_ = stmt.source;113 return true;114 }115 bool Pre(const parser::CallStmt &x) {116 if (x.typedCall.get()) {117 if (auto bad{FindImpureCall(context_.foldingContext(), *x.typedCall)}) {118 context_.Say(currentStatementSourcePosition_,119 "Impure procedure '%s' may not be referenced in DO CONCURRENT"_err_en_US,120 *bad);121 }122 }123 return true;124 }125 bool Pre(const parser::ConcurrentHeader &) {126 // handled in CheckConcurrentHeader127 return false;128 }129 template <typename T> void Post(const T &) {}130 131 // C1140 -- Can't deallocate a polymorphic entity in a DO CONCURRENT.132 // Deallocation can be caused by exiting a block that declares an allocatable133 // entity, assignment to an allocatable variable, or an actual DEALLOCATE134 // statement135 //136 // Note also that the deallocation of a derived type entity might cause the137 // invocation of an IMPURE final subroutine. (C1139)138 //139 140 // Predicate for deallocations caused by block exit and direct deallocation141 static bool DeallocateAll(const Symbol &) { return true; }142 143 // Predicate for deallocations caused by intrinsic assignment144 static bool DeallocateNonCoarray(const Symbol &component) {145 return !evaluate::IsCoarray(component);146 }147 148 static bool WillDeallocatePolymorphic(const Symbol &entity,149 const std::function<bool(const Symbol &)> &WillDeallocate) {150 return WillDeallocate(entity) && IsPolymorphicAllocatable(entity);151 }152 153 // Is it possible that we will we deallocate a polymorphic entity or one154 // of its components?155 static bool MightDeallocatePolymorphic(const Symbol &original,156 const std::function<bool(const Symbol &)> &WillDeallocate) {157 const Symbol &symbol{158 ResolveAssociations(original, /*stopAtTypeGuard=*/true)};159 // Check the entity itself, no coarray exception here160 if (IsPolymorphicAllocatable(symbol)) {161 return true;162 }163 // Check the components164 if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {165 if (const DeclTypeSpec * entityType{details->type()}) {166 if (const DerivedTypeSpec * derivedType{entityType->AsDerived()}) {167 UltimateComponentIterator ultimates{*derivedType};168 for (const auto &ultimate : ultimates) {169 if (WillDeallocatePolymorphic(ultimate, WillDeallocate)) {170 return true;171 }172 }173 }174 }175 }176 return false;177 }178 179 void SayDeallocateWithImpureFinal(180 const Symbol &entity, const char *reason, const Symbol &impure) {181 context_.SayWithDecl(entity, currentStatementSourcePosition_,182 "Deallocation of an entity with an IMPURE FINAL procedure '%s' caused by %s not allowed in DO CONCURRENT"_err_en_US,183 impure.name(), reason);184 }185 186 void SayDeallocateOfPolymorphic(187 parser::CharBlock location, const Symbol &entity, const char *reason) {188 context_.SayWithDecl(entity, location,189 "Deallocation of a polymorphic entity caused by %s not allowed in DO CONCURRENT"_err_en_US,190 reason);191 }192 193 // Deallocation caused by block exit194 // Allocatable entities and all of their allocatable subcomponents will be195 // deallocated. This test is different from the other two because it does196 // not deallocate in cases where the entity itself is not allocatable but197 // has allocatable polymorphic components198 void Post(const parser::BlockConstruct &blockConstruct) {199 const auto &endBlockStmt{200 std::get<parser::Statement<parser::EndBlockStmt>>(blockConstruct.t)};201 const Scope &blockScope{context_.FindScope(endBlockStmt.source)};202 const Scope &doScope{context_.FindScope(doConcurrentSourcePosition_)};203 if (DoesScopeContain(&doScope, blockScope)) {204 const char *reason{"block exit"};205 for (auto &pair : blockScope) {206 const Symbol &entity{*pair.second};207 if (IsAllocatable(entity) && !IsSaved(entity) &&208 MightDeallocatePolymorphic(entity, DeallocateAll)) {209 SayDeallocateOfPolymorphic(endBlockStmt.source, entity, reason);210 }211 if (const Symbol * impure{HasImpureFinal(entity)}) {212 SayDeallocateWithImpureFinal(entity, reason, *impure);213 }214 }215 }216 }217 218 // Deallocation caused by assignment219 // Note that this case does not cause deallocation of coarray components220 void Post(const parser::AssignmentStmt &stmt) {221 const auto &variable{std::get<parser::Variable>(stmt.t)};222 if (const Symbol * entity{GetLastName(variable).symbol}) {223 const char *reason{"assignment"};224 if (MightDeallocatePolymorphic(*entity, DeallocateNonCoarray)) {225 SayDeallocateOfPolymorphic(variable.GetSource(), *entity, reason);226 }227 if (const auto *assignment{GetAssignment(stmt)}) {228 const auto &lhs{assignment->lhs};229 if (const Symbol * impure{HasImpureFinal(*entity, lhs.Rank())}) {230 SayDeallocateWithImpureFinal(*entity, reason, *impure);231 }232 }233 }234 if (const auto *assignment{GetAssignment(stmt)}) {235 if (const auto *call{236 std::get_if<evaluate::ProcedureRef>(&assignment->u)}) {237 if (auto bad{FindImpureCall(context_.foldingContext(), *call)}) {238 context_.Say(currentStatementSourcePosition_,239 "The defined assignment subroutine '%s' is not pure"_err_en_US,240 *bad);241 }242 }243 }244 }245 246 // Deallocation from a DEALLOCATE statement247 // This case is different because DEALLOCATE statements deallocate both248 // ALLOCATABLE and POINTER entities249 void Post(const parser::DeallocateStmt &stmt) {250 const auto &allocateObjectList{251 std::get<std::list<parser::AllocateObject>>(stmt.t)};252 for (const auto &allocateObject : allocateObjectList) {253 const parser::Name &name{GetLastName(allocateObject)};254 const char *reason{"a DEALLOCATE statement"};255 if (name.symbol) {256 const Symbol &entity{*name.symbol};257 const DeclTypeSpec *entityType{entity.GetType()};258 if ((entityType && entityType->IsPolymorphic()) || // POINTER case259 MightDeallocatePolymorphic(entity, DeallocateAll)) {260 SayDeallocateOfPolymorphic(261 currentStatementSourcePosition_, entity, reason);262 }263 if (const Symbol * impure{HasImpureFinal(entity)}) {264 SayDeallocateWithImpureFinal(entity, reason, *impure);265 }266 }267 }268 }269 270 // C1137 -- No image control statements in a DO CONCURRENT271 void Post(const parser::ExecutableConstruct &construct) {272 if (IsImageControlStmt(construct)) {273 const parser::CharBlock statementLocation{274 GetImageControlStmtLocation(construct)};275 auto &msg{context_.Say(statementLocation,276 "An image control statement is not allowed in DO CONCURRENT"_err_en_US)};277 if (auto coarrayMsg{GetImageControlStmtCoarrayMsg(construct)}) {278 msg.Attach(statementLocation, *coarrayMsg);279 }280 msg.Attach(doConcurrentSourcePosition_, GetEnclosingDoMsg());281 }282 }283 284 // C1136 -- No RETURN statements in a DO CONCURRENT285 void Post(const parser::ReturnStmt &) {286 context_287 .Say(currentStatementSourcePosition_,288 "RETURN is not allowed in DO CONCURRENT"_err_en_US)289 .Attach(doConcurrentSourcePosition_, GetEnclosingDoMsg());290 }291 292 // C1145, C1146: cannot call ieee_[gs]et_flag, ieee_[gs]et_halting_mode,293 // ieee_[gs]et_status, ieee_set_rounding_mode, or ieee_set_underflow_mode294 void Post(const parser::ProcedureDesignator &procedureDesignator) {295 if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {296 if (name->symbol) {297 const Symbol &ultimate{name->symbol->GetUltimate()};298 const Scope &scope{ultimate.owner()};299 if (const Symbol * module{scope.IsModule() ? scope.symbol() : nullptr};300 module &&301 (module->name() == "__fortran_ieee_arithmetic" ||302 module->name() == "__fortran_ieee_exceptions")) {303 std::string s{ultimate.name().ToString()};304 static constexpr const char *badName[]{"ieee_get_flag",305 "ieee_set_flag", "ieee_get_halting_mode", "ieee_set_halting_mode",306 "ieee_get_status", "ieee_set_status", "ieee_set_rounding_mode",307 "ieee_set_underflow_mode", nullptr};308 for (std::size_t j{0}; badName[j]; ++j) {309 if (s.find(badName[j]) != s.npos) {310 context_311 .Say(name->source,312 "'%s' may not be called in DO CONCURRENT"_err_en_US,313 badName[j])314 .Attach(doConcurrentSourcePosition_, GetEnclosingDoMsg());315 break;316 }317 }318 }319 }320 }321 }322 323 // 11.1.7.5, paragraph 5, no ADVANCE specifier in a DO CONCURRENT324 void Post(const parser::IoControlSpec &ioControlSpec) {325 if (auto *charExpr{326 std::get_if<parser::IoControlSpec::CharExpr>(&ioControlSpec.u)}) {327 if (std::get<parser::IoControlSpec::CharExpr::Kind>(charExpr->t) ==328 parser::IoControlSpec::CharExpr::Kind::Advance) {329 SayWithDo(context_, currentStatementSourcePosition_,330 "ADVANCE specifier is not allowed in DO"331 " CONCURRENT"_err_en_US,332 doConcurrentSourcePosition_);333 }334 }335 }336 337private:338 std::set<parser::Label> labels_;339 parser::CharBlock currentStatementSourcePosition_;340 SemanticsContext &context_;341 parser::CharBlock doConcurrentSourcePosition_;342}; // class DoConcurrentBodyEnforce343 344// Class for enforcing C1130 -- in a DO CONCURRENT with DEFAULT(NONE),345// variables from enclosing scopes must have their locality specified346class DoConcurrentVariableEnforce {347public:348 DoConcurrentVariableEnforce(349 SemanticsContext &context, parser::CharBlock doConcurrentSourcePosition)350 : context_{context},351 doConcurrentSourcePosition_{doConcurrentSourcePosition},352 blockScope_{context.FindScope(doConcurrentSourcePosition_)} {}353 354 template <typename T> bool Pre(const T &) { return true; }355 template <typename T> void Post(const T &) {}356 357 // Check to see if the name is a variable from an enclosing scope358 void Post(const parser::Name &name) {359 if (const Symbol * symbol{name.symbol}) {360 if (IsVariableName(*symbol)) {361 const Scope &variableScope{symbol->owner()};362 if (DoesScopeContain(&variableScope, blockScope_)) {363 context_.SayWithDecl(*symbol, name.source,364 "Variable '%s' from an enclosing scope referenced in DO "365 "CONCURRENT with DEFAULT(NONE) must appear in a "366 "locality-spec"_err_en_US,367 symbol->name());368 }369 }370 }371 }372 373private:374 SemanticsContext &context_;375 parser::CharBlock doConcurrentSourcePosition_;376 const Scope &blockScope_;377}; // class DoConcurrentVariableEnforce378 379// Find a DO or FORALL and enforce semantics checks on its body380class DoContext {381public:382 DoContext(SemanticsContext &context, IndexVarKind kind,383 const std::list<IndexVarKind> nesting)384 : context_{context}, kind_{kind} {385 if (!nesting.empty()) {386 concurrentNesting_ = nesting.back();387 }388 }389 390 // Mark this DO construct as a point of definition for the DO variables391 // or index-names it contains. If they're already defined, emit an error392 // message. We need to remember both the variable and the source location of393 // the variable in the DO construct so that we can remove it when we leave394 // the DO construct and use its location in error messages.395 void DefineDoVariables(const parser::DoConstruct &doConstruct) {396 if (doConstruct.IsDoNormal()) {397 context_.ActivateIndexVar(GetDoVariable(doConstruct), IndexVarKind::DO);398 } else if (doConstruct.IsDoConcurrent()) {399 if (const auto &loopControl{doConstruct.GetLoopControl()}) {400 ActivateIndexVars(GetControls(*loopControl));401 }402 }403 }404 405 // Called at the end of a DO construct to deactivate the DO construct406 void ResetDoVariables(const parser::DoConstruct &doConstruct) {407 if (doConstruct.IsDoNormal()) {408 context_.DeactivateIndexVar(GetDoVariable(doConstruct));409 } else if (doConstruct.IsDoConcurrent()) {410 if (const auto &loopControl{doConstruct.GetLoopControl()}) {411 DeactivateIndexVars(GetControls(*loopControl));412 }413 }414 }415 416 void ActivateIndexVars(const std::list<parser::ConcurrentControl> &controls) {417 for (const auto &control : controls) {418 context_.ActivateIndexVar(std::get<parser::Name>(control.t), kind_);419 }420 }421 void DeactivateIndexVars(422 const std::list<parser::ConcurrentControl> &controls) {423 for (const auto &control : controls) {424 context_.DeactivateIndexVar(std::get<parser::Name>(control.t));425 }426 }427 428 void Check(const parser::DoConstruct &doConstruct) {429 if (doConstruct.IsDoConcurrent()) {430 CheckDoConcurrent(doConstruct);431 } else if (doConstruct.IsDoNormal()) {432 CheckDoNormal(doConstruct);433 } else {434 // TODO: handle the other cases435 }436 }437 438 void Check(const parser::ForallStmt &stmt) {439 CheckConcurrentHeader(GetConcurrentHeader(stmt));440 }441 void Check(const parser::ForallConstruct &construct) {442 CheckConcurrentHeader(GetConcurrentHeader(construct));443 }444 445 void Check(const parser::ForallAssignmentStmt &stmt) {446 if (const evaluate::Assignment *447 assignment{common::visit(448 common::visitors{[&](const auto &x) { return GetAssignment(x); }},449 stmt.u)}) {450 CheckForallIndexesUsed(*assignment);451 CheckForImpureCall(assignment->lhs, kind_);452 CheckForImpureCall(assignment->rhs, kind_);453 454 if (IsVariable(assignment->lhs)) {455 if (const Symbol * symbol{GetLastSymbol(assignment->lhs)}) {456 if (auto impureFinal{457 HasImpureFinal(*symbol, assignment->lhs.Rank())}) {458 context_.SayWithDecl(*symbol, parser::FindSourceLocation(stmt),459 "Impure procedure '%s' is referenced by finalization in a %s"_err_en_US,460 impureFinal->name(), LoopKindName());461 }462 }463 }464 465 if (const auto *proc{466 std::get_if<evaluate::ProcedureRef>(&assignment->u)}) {467 CheckForImpureCall(*proc, kind_);468 }469 common::visit(470 common::visitors{471 [](const evaluate::Assignment::Intrinsic &) {},472 [&](const evaluate::ProcedureRef &proc) {473 CheckForImpureCall(proc, kind_);474 },475 [&](const evaluate::Assignment::BoundsSpec &bounds) {476 for (const auto &bound : bounds) {477 CheckForImpureCall(SomeExpr{bound}, kind_);478 }479 },480 [&](const evaluate::Assignment::BoundsRemapping &bounds) {481 for (const auto &bound : bounds) {482 CheckForImpureCall(SomeExpr{bound.first}, kind_);483 CheckForImpureCall(SomeExpr{bound.second}, kind_);484 }485 },486 },487 assignment->u);488 }489 }490 491private:492 void SayBadDoControl(parser::CharBlock sourceLocation) {493 context_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);494 }495 496 void CheckDoControl(const parser::CharBlock &sourceLocation, bool isReal) {497 if (isReal) {498 context_.Warn(common::LanguageFeature::RealDoControls, sourceLocation,499 "DO controls should be INTEGER"_port_en_US);500 } else {501 SayBadDoControl(sourceLocation);502 }503 }504 505 void CheckDoVariable(const parser::ScalarName &scalarName) {506 const parser::CharBlock &sourceLocation{scalarName.thing.source};507 if (const Symbol * symbol{scalarName.thing.symbol}) {508 if (!IsVariableName(*symbol)) {509 context_.Say(510 sourceLocation, "DO control must be an INTEGER variable"_err_en_US);511 } else if (auto why{WhyNotDefinable(sourceLocation,512 context_.FindScope(sourceLocation), DefinabilityFlags{},513 *symbol)}) {514 context_515 .Say(sourceLocation,516 "'%s' may not be used as a DO variable"_err_en_US,517 symbol->name())518 .Attach(std::move(why->set_severity(parser::Severity::Because)));519 } else {520 const DeclTypeSpec *symType{symbol->GetType()};521 if (!symType) {522 SayBadDoControl(sourceLocation);523 } else {524 if (!symType->IsNumeric(TypeCategory::Integer)) {525 CheckDoControl(526 sourceLocation, symType->IsNumeric(TypeCategory::Real));527 }528 }529 } // No messages for INTEGER530 }531 }532 533 // Semantic checks for the limit and step expressions534 void CheckDoExpression(const parser::ScalarExpr &scalarExpression) {535 if (const SomeExpr * expr{GetExpr(context_, scalarExpression)}) {536 if (!ExprHasTypeCategory(*expr, TypeCategory::Integer)) {537 // No warnings or errors for type INTEGER538 parser::CharBlock loc{539 parser::UnwrapRef<parser::Expr>(scalarExpression).source};540 CheckDoControl(loc, ExprHasTypeCategory(*expr, TypeCategory::Real));541 }542 }543 }544 545 void CheckDoNormal(const parser::DoConstruct &doConstruct) {546 // C1120 -- types of DO variables must be INTEGER, extended by allowing547 // REAL and DOUBLE PRECISION548 const Bounds &bounds{GetBounds(doConstruct)};549 CheckDoVariable(bounds.name);550 CheckDoExpression(bounds.lower);551 CheckDoExpression(bounds.upper);552 if (bounds.step) {553 CheckDoExpression(*bounds.step);554 if (IsZero(*bounds.step)) {555 context_.Warn(common::UsageWarning::ZeroDoStep,556 parser::UnwrapRef<parser::Expr>(bounds.step).source,557 "DO step expression should not be zero"_warn_en_US);558 }559 }560 }561 562 void CheckDoConcurrent(const parser::DoConstruct &doConstruct) {563 auto &doStmt{564 std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)};565 currentStatementSourcePosition_ = doStmt.source;566 567 const parser::Block &block{std::get<parser::Block>(doConstruct.t)};568 DoConcurrentBodyEnforce doConcurrentBodyEnforce{context_, doStmt.source};569 parser::Walk(block, doConcurrentBodyEnforce);570 571 LabelEnforce doConcurrentLabelEnforce{context_,572 doConcurrentBodyEnforce.labels(), currentStatementSourcePosition_,573 "DO CONCURRENT"};574 parser::Walk(block, doConcurrentLabelEnforce);575 576 const auto &loopControl{doConstruct.GetLoopControl()};577 CheckConcurrentLoopControl(*loopControl);578 CheckLocalitySpecs(*loopControl, block);579 }580 581 // Return a set of symbols whose names are in a Local locality-spec. Look582 // the names up in the scope that encloses the DO construct to avoid getting583 // the local versions of them. Then follow the host-, use-, and584 // construct-associations to get the root symbols585 UnorderedSymbolSet GatherLocals(586 const std::list<parser::LocalitySpec> &localitySpecs) const {587 UnorderedSymbolSet symbols;588 const Scope &parentScope{589 context_.FindScope(currentStatementSourcePosition_).parent()};590 // Loop through the LocalitySpec::Local locality-specs591 for (const auto &ls : localitySpecs) {592 if (const auto *names{std::get_if<parser::LocalitySpec::Local>(&ls.u)}) {593 // Loop through the names in the Local locality-spec getting their594 // symbols595 for (const parser::Name &name : names->v) {596 if (const Symbol * symbol{parentScope.FindSymbol(name.source)}) {597 symbols.insert(ResolveAssociations(*symbol));598 }599 }600 }601 }602 return symbols;603 }604 605 UnorderedSymbolSet GatherSymbolsFromExpression(606 const parser::Expr &expression) const {607 UnorderedSymbolSet result;608 if (const auto *expr{GetExpr(context_, expression)}) {609 for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {610 result.insert(ResolveAssociations(symbol));611 }612 }613 return result;614 }615 616 // C1121 - procedures in mask must be pure617 void CheckMaskIsPure(const parser::ScalarLogicalExpr &mask) const {618 UnorderedSymbolSet references{619 GatherSymbolsFromExpression(parser::UnwrapRef<parser::Expr>(mask))};620 for (const Symbol &ref : OrderBySourcePosition(references)) {621 if (IsProcedure(ref) && !IsPureProcedure(ref)) {622 context_.SayWithDecl(ref, parser::Unwrap<parser::Expr>(mask)->source,623 "%s mask expression may not reference impure procedure '%s'"_err_en_US,624 LoopKindName(), ref.name());625 return;626 }627 }628 }629 630 void CheckNoCollisions(const UnorderedSymbolSet &refs,631 const UnorderedSymbolSet &uses, parser::MessageFixedText &&errorMessage,632 const parser::CharBlock &refPosition) const {633 for (const Symbol &ref : OrderBySourcePosition(refs)) {634 if (uses.find(ref) != uses.end()) {635 context_.SayWithDecl(ref, refPosition, std::move(errorMessage),636 LoopKindName(), ref.name());637 return;638 }639 }640 }641 642 void HasNoReferences(const UnorderedSymbolSet &indexNames,643 const parser::ScalarIntExpr &scalarIntExpr) const {644 const auto &expr{parser::UnwrapRef<parser::Expr>(scalarIntExpr)};645 CheckNoCollisions(GatherSymbolsFromExpression(expr), indexNames,646 "%s limit expression may not reference index variable '%s'"_err_en_US,647 expr.source);648 }649 650 // C1129, names in local locality-specs can't be in mask expressions651 void CheckMaskDoesNotReferenceLocal(const parser::ScalarLogicalExpr &mask,652 const UnorderedSymbolSet &localVars) const {653 const auto &expr{parser::UnwrapRef<parser::Expr>(mask)};654 CheckNoCollisions(GatherSymbolsFromExpression(expr), localVars,655 "%s mask expression references variable '%s'"656 " in LOCAL locality-spec"_err_en_US,657 expr.source);658 }659 660 // C1129, names in local locality-specs can't be in limit or step661 // expressions662 void CheckExprDoesNotReferenceLocal(663 const parser::ScalarIntExpr &scalarIntExpr,664 const UnorderedSymbolSet &localVars) const {665 const auto &expr{parser::UnwrapRef<parser::Expr>(scalarIntExpr)};666 CheckNoCollisions(GatherSymbolsFromExpression(expr), localVars,667 "%s expression references variable '%s'"668 " in LOCAL locality-spec"_err_en_US,669 expr.source);670 }671 672 // C1130, DEFAULT(NONE) locality requires names to be in locality-specs to673 // be used in the body of the DO loop674 void CheckDefaultNoneImpliesExplicitLocality(675 const std::list<parser::LocalitySpec> &localitySpecs,676 const parser::Block &block) const {677 bool hasDefaultNone{false};678 for (auto &ls : localitySpecs) {679 if (std::holds_alternative<parser::LocalitySpec::DefaultNone>(ls.u)) {680 if (hasDefaultNone) {681 // F'2023 C1129, you can only have one DEFAULT(NONE)682 context_.Warn(common::LanguageFeature::BenignRedundancy,683 currentStatementSourcePosition_,684 "Only one DEFAULT(NONE) may appear"_port_en_US);685 break;686 }687 hasDefaultNone = true;688 }689 }690 if (hasDefaultNone) {691 DoConcurrentVariableEnforce doConcurrentVariableEnforce{692 context_, currentStatementSourcePosition_};693 parser::Walk(block, doConcurrentVariableEnforce);694 }695 }696 697 void CheckReduce(const parser::LocalitySpec::Reduce &reduce) const {698 const parser::ReductionOperator &reductionOperator{699 std::get<parser::ReductionOperator>(reduce.t)};700 // F'2023 C1132, reduction variables should have suitable intrinsic type701 for (const parser::Name &x : std::get<std::list<parser::Name>>(reduce.t)) {702 bool supportedIdentifier{false};703 if (x.symbol && x.symbol->GetType()) {704 const auto *type{x.symbol->GetType()};705 auto typeMismatch{[&](const char *suitable_types) {706 context_.Say(currentStatementSourcePosition_,707 "Reduction variable '%s' ('%s') does not have a suitable type ('%s')."_err_en_US,708 x.symbol->name(), type->AsFortran(), suitable_types);709 }};710 supportedIdentifier = true;711 switch (reductionOperator.v) {712 case parser::ReductionOperator::Operator::Plus:713 case parser::ReductionOperator::Operator::Multiply:714 if (!(type->IsNumeric(TypeCategory::Complex) ||715 type->IsNumeric(TypeCategory::Integer) ||716 type->IsNumeric(TypeCategory::Real))) {717 typeMismatch("COMPLEX', 'INTEGER', or 'REAL");718 }719 break;720 case parser::ReductionOperator::Operator::And:721 case parser::ReductionOperator::Operator::Or:722 case parser::ReductionOperator::Operator::Eqv:723 case parser::ReductionOperator::Operator::Neqv:724 if (type->category() != DeclTypeSpec::Category::Logical) {725 typeMismatch("LOGICAL");726 }727 break;728 case parser::ReductionOperator::Operator::Max:729 case parser::ReductionOperator::Operator::Min:730 if (!(type->IsNumeric(TypeCategory::Integer) ||731 type->IsNumeric(TypeCategory::Real))) {732 typeMismatch("INTEGER', or 'REAL");733 }734 break;735 case parser::ReductionOperator::Operator::Iand:736 case parser::ReductionOperator::Operator::Ior:737 case parser::ReductionOperator::Operator::Ieor:738 if (!type->IsNumeric(TypeCategory::Integer)) {739 typeMismatch("INTEGER");740 }741 break;742 }743 }744 if (!supportedIdentifier) {745 context_.Say(currentStatementSourcePosition_,746 "Invalid identifier in REDUCE clause."_err_en_US);747 }748 }749 }750 751 // C1123, concurrent limit or step expressions can't reference index-names752 void CheckConcurrentHeader(const parser::ConcurrentHeader &header) const {753 if (const auto &mask{754 std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {755 CheckMaskIsPure(*mask);756 }757 const auto &controls{758 std::get<std::list<parser::ConcurrentControl>>(header.t)};759 UnorderedSymbolSet indexNames;760 for (const parser::ConcurrentControl &control : controls) {761 const auto &indexName{std::get<parser::Name>(control.t)};762 if (indexName.symbol) {763 indexNames.insert(*indexName.symbol);764 }765 CheckForImpureCall(std::get<1>(control.t), concurrentNesting_);766 CheckForImpureCall(std::get<2>(control.t), concurrentNesting_);767 if (const auto &stride{std::get<3>(control.t)}) {768 CheckForImpureCall(*stride, concurrentNesting_);769 }770 }771 if (!indexNames.empty()) {772 for (const parser::ConcurrentControl &control : controls) {773 HasNoReferences(indexNames, std::get<1>(control.t));774 HasNoReferences(indexNames, std::get<2>(control.t));775 if (const auto &intExpr{776 std::get<std::optional<parser::ScalarIntExpr>>(control.t)}) {777 const auto &expr{parser::UnwrapRef<parser::Expr>(intExpr)};778 CheckNoCollisions(GatherSymbolsFromExpression(expr), indexNames,779 "%s step expression may not reference index variable '%s'"_err_en_US,780 expr.source);781 if (IsZero(expr)) {782 context_.Say(expr.source,783 "%s step expression may not be zero"_err_en_US, LoopKindName());784 }785 }786 }787 }788 }789 790 void CheckLocalitySpecs(791 const parser::LoopControl &control, const parser::Block &block) const {792 const auto &concurrent{793 std::get<parser::LoopControl::Concurrent>(control.u)};794 const auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};795 const auto &localitySpecs{796 std::get<std::list<parser::LocalitySpec>>(concurrent.t)};797 if (!localitySpecs.empty()) {798 const UnorderedSymbolSet &localVars{GatherLocals(localitySpecs)};799 for (const auto &c : GetControls(control)) {800 CheckExprDoesNotReferenceLocal(std::get<1>(c.t), localVars);801 CheckExprDoesNotReferenceLocal(std::get<2>(c.t), localVars);802 if (const auto &expr{803 std::get<std::optional<parser::ScalarIntExpr>>(c.t)}) {804 CheckExprDoesNotReferenceLocal(*expr, localVars);805 }806 }807 if (const auto &mask{808 std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {809 CheckMaskDoesNotReferenceLocal(*mask, localVars);810 }811 for (auto &ls : localitySpecs) {812 if (const auto *reduce{813 std::get_if<parser::LocalitySpec::Reduce>(&ls.u)}) {814 CheckReduce(*reduce);815 }816 }817 CheckDefaultNoneImpliesExplicitLocality(localitySpecs, block);818 }819 }820 821 // check constraints [C1121 .. C1130]822 void CheckConcurrentLoopControl(const parser::LoopControl &control) const {823 const auto &concurrent{824 std::get<parser::LoopControl::Concurrent>(control.u)};825 CheckConcurrentHeader(std::get<parser::ConcurrentHeader>(concurrent.t));826 }827 828 template <typename T>829 void CheckForImpureCall(830 const T &x, std::optional<IndexVarKind> nesting) const {831 if (auto bad{FindImpureCall(context_.foldingContext(), x)}) {832 if (nesting) {833 context_.Say(834 "Impure procedure '%s' may not be referenced in a %s"_err_en_US,835 *bad, LoopKindName(*nesting));836 } else {837 context_.Say(838 "Impure procedure '%s' should not be referenced in a %s header"_warn_en_US,839 *bad, LoopKindName(kind_));840 }841 }842 }843 void CheckForImpureCall(const parser::ScalarIntExpr &x,844 std::optional<IndexVarKind> nesting) const {845 const auto &parsedExpr{parser::UnwrapRef<parser::Expr>(x)};846 auto oldLocation{context_.location()};847 context_.set_location(parsedExpr.source);848 if (const auto &typedExpr{parsedExpr.typedExpr}) {849 if (const auto &expr{typedExpr->v}) {850 CheckForImpureCall(*expr, nesting);851 }852 }853 context_.set_location(oldLocation);854 }855 856 // Each index should be used on the LHS of each assignment in a FORALL857 void CheckForallIndexesUsed(const evaluate::Assignment &assignment) {858 SymbolVector indexVars{context_.GetIndexVars(IndexVarKind::FORALL)};859 if (!indexVars.empty()) {860 UnorderedSymbolSet symbols{evaluate::CollectSymbols(assignment.lhs)};861 common::visit(862 common::visitors{863 [&](const evaluate::Assignment::BoundsSpec &spec) {864 for (const auto &bound : spec) {865// TODO: this is working around missing std::set::merge in some versions of866// clang that we are building with867#ifdef __clang__868 auto boundSymbols{evaluate::CollectSymbols(bound)};869 symbols.insert(boundSymbols.begin(), boundSymbols.end());870#else871 symbols.merge(evaluate::CollectSymbols(bound));872#endif873 }874 },875 [&](const evaluate::Assignment::BoundsRemapping &remapping) {876 for (const auto &bounds : remapping) {877#ifdef __clang__878 auto lbSymbols{evaluate::CollectSymbols(bounds.first)};879 symbols.insert(lbSymbols.begin(), lbSymbols.end());880 auto ubSymbols{evaluate::CollectSymbols(bounds.second)};881 symbols.insert(ubSymbols.begin(), ubSymbols.end());882#else883 symbols.merge(evaluate::CollectSymbols(bounds.first));884 symbols.merge(evaluate::CollectSymbols(bounds.second));885#endif886 }887 },888 [](const auto &) {},889 },890 assignment.u);891 for (const Symbol &index : indexVars) {892 if (symbols.count(index) == 0) {893 context_.Warn(common::UsageWarning::UnusedForallIndex,894 "FORALL index variable '%s' not used on left-hand side of assignment"_warn_en_US,895 index.name());896 }897 }898 }899 }900 901 // For messages where the DO loop must be DO CONCURRENT, make that explicit.902 const char *LoopKindName(IndexVarKind kind) const {903 return kind == IndexVarKind::DO ? "DO CONCURRENT" : "FORALL";904 }905 const char *LoopKindName() const { return LoopKindName(kind_); }906 907 SemanticsContext &context_;908 const IndexVarKind kind_;909 parser::CharBlock currentStatementSourcePosition_;910 std::optional<IndexVarKind> concurrentNesting_;911}; // class DoContext912 913void DoForallChecker::Enter(const parser::DoConstruct &doConstruct) {914 DoContext doContext{context_, IndexVarKind::DO, nestedWithinConcurrent_};915 if (doConstruct.IsDoConcurrent()) {916 nestedWithinConcurrent_.push_back(IndexVarKind::DO);917 }918 doContext.DefineDoVariables(doConstruct);919 doContext.Check(doConstruct);920}921 922void DoForallChecker::Leave(const parser::DoConstruct &doConstruct) {923 DoContext doContext{context_, IndexVarKind::DO, nestedWithinConcurrent_};924 doContext.ResetDoVariables(doConstruct);925 if (doConstruct.IsDoConcurrent()) {926 nestedWithinConcurrent_.pop_back();927 }928}929 930void DoForallChecker::Enter(const parser::ForallConstruct &construct) {931 DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};932 doContext.ActivateIndexVars(GetControls(construct));933 nestedWithinConcurrent_.push_back(IndexVarKind::FORALL);934 doContext.Check(construct);935}936void DoForallChecker::Leave(const parser::ForallConstruct &construct) {937 DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};938 doContext.DeactivateIndexVars(GetControls(construct));939 nestedWithinConcurrent_.pop_back();940}941 942void DoForallChecker::Enter(const parser::ForallStmt &stmt) {943 DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};944 nestedWithinConcurrent_.push_back(IndexVarKind::FORALL);945 doContext.Check(stmt);946 doContext.ActivateIndexVars(GetControls(stmt));947}948void DoForallChecker::Leave(const parser::ForallStmt &stmt) {949 DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};950 doContext.DeactivateIndexVars(GetControls(stmt));951 nestedWithinConcurrent_.pop_back();952}953void DoForallChecker::Leave(const parser::ForallAssignmentStmt &stmt) {954 DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};955 doContext.Check(stmt);956}957 958template <typename A>959static parser::CharBlock GetConstructPosition(const A &a) {960 return std::get<0>(a.t).source;961}962 963static parser::CharBlock GetNodePosition(const ConstructNode &construct) {964 return common::visit(965 [&](const auto &x) { return GetConstructPosition(*x); }, construct);966}967 968void DoForallChecker::SayBadLeave(StmtType stmtType,969 const char *enclosingStmtName, const ConstructNode &construct) const {970 context_971 .Say("%s must not leave a %s statement"_err_en_US, EnumToString(stmtType),972 enclosingStmtName)973 .Attach(GetNodePosition(construct), "The construct that was left"_en_US);974}975 976static const parser::DoConstruct *MaybeGetDoConstruct(977 const ConstructNode &construct) {978 if (const auto *doNode{979 std::get_if<const parser::DoConstruct *>(&construct)}) {980 return *doNode;981 } else {982 return nullptr;983 }984}985 986static bool ConstructIsDoConcurrent(const ConstructNode &construct) {987 const parser::DoConstruct *doConstruct{MaybeGetDoConstruct(construct)};988 return doConstruct && doConstruct->IsDoConcurrent();989}990 991// Check that CYCLE and EXIT statements do not cause flow of control to992// leave DO CONCURRENT, CRITICAL, or CHANGE TEAM constructs.993void DoForallChecker::CheckForBadLeave(994 StmtType stmtType, const ConstructNode &construct) const {995 common::visit(common::visitors{996 [&](const parser::DoConstruct *doConstructPtr) {997 if (doConstructPtr->IsDoConcurrent()) {998 // C1135 and C1167 -- CYCLE and EXIT statements can't999 // leave a DO CONCURRENT1000 SayBadLeave(stmtType, "DO CONCURRENT", construct);1001 }1002 },1003 [&](const parser::CriticalConstruct *) {1004 // C1135 and C1168 -- similarly, for CRITICAL1005 SayBadLeave(stmtType, "CRITICAL", construct);1006 },1007 [&](const parser::ChangeTeamConstruct *) {1008 // C1135 and C1168 -- similarly, for CHANGE TEAM1009 SayBadLeave(stmtType, "CHANGE TEAM", construct);1010 },1011 [](const auto *) {},1012 },1013 construct);1014}1015 1016static bool StmtMatchesConstruct(const parser::Name *stmtName,1017 StmtType stmtType, const std::optional<parser::Name> &constructName,1018 const ConstructNode &construct) {1019 bool inDoConstruct{MaybeGetDoConstruct(construct) != nullptr};1020 if (!stmtName) {1021 return inDoConstruct; // Unlabeled statements match all DO constructs1022 } else if (constructName && constructName->source == stmtName->source) {1023 return stmtType == StmtType::EXIT || inDoConstruct;1024 } else {1025 return false;1026 }1027}1028 1029// C1167 Can't EXIT from a DO CONCURRENT1030void DoForallChecker::CheckDoConcurrentExit(1031 StmtType stmtType, const ConstructNode &construct) const {1032 if (stmtType == StmtType::EXIT && ConstructIsDoConcurrent(construct)) {1033 SayBadLeave(StmtType::EXIT, "DO CONCURRENT", construct);1034 }1035}1036 1037// Check nesting violations for a CYCLE or EXIT statement. Loop up the1038// nesting levels looking for a construct that matches the CYCLE or EXIT1039// statment. At every construct, check for a violation. If we find a match1040// without finding a violation, the check is complete.1041void DoForallChecker::CheckNesting(1042 StmtType stmtType, const parser::Name *stmtName) const {1043 const ConstructStack &stack{context_.constructStack()};1044 for (auto iter{stack.cend()}; iter-- != stack.cbegin();) {1045 const ConstructNode &construct{*iter};1046 const std::optional<parser::Name> &constructName{1047 MaybeGetNodeName(construct)};1048 if (StmtMatchesConstruct(stmtName, stmtType, constructName, construct)) {1049 CheckDoConcurrentExit(stmtType, construct);1050 return; // We got a match, so we're finished checking1051 }1052 CheckForBadLeave(stmtType, construct);1053 }1054 1055 // We haven't found a match in the enclosing constructs1056 if (stmtType == StmtType::EXIT) {1057 context_.Say("No matching construct for EXIT statement"_err_en_US);1058 } else {1059 context_.Say("No matching DO construct for CYCLE statement"_err_en_US);1060 }1061}1062 1063// C1135 -- Nesting for CYCLE statements1064void DoForallChecker::Enter(const parser::CycleStmt &cycleStmt) {1065 CheckNesting(StmtType::CYCLE, common::GetPtrFromOptional(cycleStmt.v));1066}1067 1068// C1167 and C1168 -- Nesting for EXIT statements1069void DoForallChecker::Enter(const parser::ExitStmt &exitStmt) {1070 CheckNesting(StmtType::EXIT, common::GetPtrFromOptional(exitStmt.v));1071}1072 1073void DoForallChecker::Leave(const parser::AssignmentStmt &stmt) {1074 const auto &variable{std::get<parser::Variable>(stmt.t)};1075 context_.CheckIndexVarRedefine(variable);1076}1077 1078static void CheckIfArgIsDoVar(const evaluate::ActualArgument &arg,1079 const parser::CharBlock location, SemanticsContext &context) {1080 common::Intent intent{arg.dummyIntent()};1081 if (intent == common::Intent::Out || intent == common::Intent::InOut) {1082 if (const SomeExpr * argExpr{arg.UnwrapExpr()}) {1083 if (const Symbol * var{evaluate::UnwrapWholeSymbolDataRef(*argExpr)}) {1084 if (intent == common::Intent::Out) {1085 context.CheckIndexVarRedefine(location, *var);1086 } else {1087 context.WarnIndexVarRedefine(location, *var); // INTENT(INOUT)1088 }1089 }1090 }1091 }1092}1093 1094// Check to see if a DO variable is being passed as an actual argument to a1095// dummy argument whose intent is OUT or INOUT. To do this, we need to find1096// the expressions for actual arguments which contain DO variables. We get the1097// intents of the dummy arguments from the ProcedureRef in the "typedCall"1098// field of the CallStmt which was filled in during expression checking. At1099// the same time, we need to iterate over the parser::Expr versions of the1100// actual arguments to get their source locations of the arguments for the1101// messages.1102void DoForallChecker::Leave(const parser::CallStmt &callStmt) {1103 if (const auto &typedCall{callStmt.typedCall}) {1104 const auto &parsedArgs{1105 std::get<std::list<parser::ActualArgSpec>>(callStmt.call.t)};1106 auto parsedArgIter{parsedArgs.begin()};1107 const evaluate::ActualArguments &checkedArgs{typedCall->arguments()};1108 for (const auto &checkedOptionalArg : checkedArgs) {1109 if (parsedArgIter == parsedArgs.end()) {1110 break; // No more parsed arguments, we're done.1111 }1112 const auto &parsedArg{std::get<parser::ActualArg>(parsedArgIter->t)};1113 ++parsedArgIter;1114 if (checkedOptionalArg) {1115 const evaluate::ActualArgument &checkedArg{*checkedOptionalArg};1116 if (const auto *parsedExpr{1117 std::get_if<common::Indirection<parser::Expr>>(&parsedArg.u)}) {1118 CheckIfArgIsDoVar(checkedArg, parsedExpr->value().source, context_);1119 }1120 }1121 }1122 }1123}1124 1125void DoForallChecker::Leave(const parser::ConnectSpec &connectSpec) {1126 const auto *newunit{1127 std::get_if<parser::ConnectSpec::Newunit>(&connectSpec.u)};1128 if (newunit) {1129 context_.CheckIndexVarRedefine(1130 parser::UnwrapRef<parser::Variable>(newunit));1131 }1132}1133 1134using ActualArgumentSet = std::set<evaluate::ActualArgumentRef>;1135 1136struct CollectActualArgumentsHelper1137 : public evaluate::SetTraverse<CollectActualArgumentsHelper,1138 ActualArgumentSet> {1139 using Base = SetTraverse<CollectActualArgumentsHelper, ActualArgumentSet>;1140 CollectActualArgumentsHelper() : Base{*this} {}1141 using Base::operator();1142 ActualArgumentSet operator()(const evaluate::ActualArgument &arg) const {1143 return Combine(ActualArgumentSet{arg},1144 CollectActualArgumentsHelper{}(arg.UnwrapExpr()));1145 }1146};1147 1148template <typename A> ActualArgumentSet CollectActualArguments(const A &x) {1149 return CollectActualArgumentsHelper{}(x);1150}1151 1152template ActualArgumentSet CollectActualArguments(const SomeExpr &);1153 1154void DoForallChecker::Enter(const parser::Expr &parsedExpr) { ++exprDepth_; }1155 1156void DoForallChecker::Leave(const parser::Expr &parsedExpr) {1157 CHECK(exprDepth_ > 0);1158 if (--exprDepth_ == 0) { // Only check top level expressions1159 if (const SomeExpr * expr{GetExpr(context_, parsedExpr)}) {1160 ActualArgumentSet argSet{CollectActualArguments(*expr)};1161 for (const evaluate::ActualArgumentRef &argRef : argSet) {1162 CheckIfArgIsDoVar(*argRef, parsedExpr.source, context_);1163 }1164 }1165 }1166}1167 1168void DoForallChecker::Leave(const parser::InquireSpec &inquireSpec) {1169 const auto *intVar{std::get_if<parser::InquireSpec::IntVar>(&inquireSpec.u)};1170 if (intVar) {1171 const auto &scalar{std::get<parser::ScalarIntVariable>(intVar->t)};1172 context_.CheckIndexVarRedefine(parser::UnwrapRef<parser::Variable>(scalar));1173 }1174}1175 1176void DoForallChecker::Leave(const parser::IoControlSpec &ioControlSpec) {1177 const auto *size{std::get_if<parser::IoControlSpec::Size>(&ioControlSpec.u)};1178 if (size) {1179 context_.CheckIndexVarRedefine(parser::UnwrapRef<parser::Variable>(size));1180 }1181}1182 1183static void CheckIoImpliedDoIndex(1184 SemanticsContext &context, const parser::Name &name) {1185 if (name.symbol) {1186 context.CheckIndexVarRedefine(name.source, *name.symbol);1187 if (auto why{WhyNotDefinable(name.source, name.symbol->owner(),1188 DefinabilityFlags{}, *name.symbol)}) {1189 context.Say(std::move(*why));1190 }1191 }1192}1193 1194void DoForallChecker::Leave(const parser::OutputImpliedDo &outputImpliedDo) {1195 CheckIoImpliedDoIndex(context_,1196 parser::UnwrapRef<parser::Name>(1197 std::get<parser::IoImpliedDoControl>(outputImpliedDo.t).name));1198}1199 1200void DoForallChecker::Leave(const parser::InputImpliedDo &inputImpliedDo) {1201 CheckIoImpliedDoIndex(context_,1202 parser::UnwrapRef<parser::Name>(1203 std::get<parser::IoImpliedDoControl>(inputImpliedDo.t).name));1204}1205 1206void DoForallChecker::Leave(const parser::StatVariable &statVariable) {1207 context_.CheckIndexVarRedefine(1208 parser::UnwrapRef<parser::Variable>(statVariable));1209}1210 1211} // namespace Fortran::semantics1212