1 //===-- lib/Semantics/check-coarray.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-coarray.h" 10 #include "flang/Common/indirection.h" 11 #include "flang/Evaluate/expression.h" 12 #include "flang/Parser/message.h" 13 #include "flang/Parser/parse-tree.h" 14 #include "flang/Parser/tools.h" 15 #include "flang/Semantics/expression.h" 16 #include "flang/Semantics/tools.h" 17 18 namespace Fortran::semantics { 19 20 class CriticalBodyEnforce { 21 public: 22 CriticalBodyEnforce( 23 SemanticsContext &context, parser::CharBlock criticalSourcePosition) 24 : context_{context}, criticalSourcePosition_{criticalSourcePosition} {} 25 std::set<parser::Label> labels() { return labels_; } 26 template <typename T> bool Pre(const T &) { return true; } 27 template <typename T> void Post(const T &) {} 28 29 template <typename T> bool Pre(const parser::Statement<T> &statement) { 30 currentStatementSourcePosition_ = statement.source; 31 if (statement.label.has_value()) { 32 labels_.insert(*statement.label); 33 } 34 return true; 35 } 36 37 // C1118 38 void Post(const parser::ReturnStmt &) { 39 context_ 40 .Say(currentStatementSourcePosition_, 41 "RETURN statement is not allowed in a CRITICAL construct"_err_en_US) 42 .Attach(criticalSourcePosition_, GetEnclosingMsg()); 43 } 44 void Post(const parser::ExecutableConstruct &construct) { 45 if (IsImageControlStmt(construct)) { 46 context_ 47 .Say(currentStatementSourcePosition_, 48 "An image control statement is not allowed in a CRITICAL" 49 " construct"_err_en_US) 50 .Attach(criticalSourcePosition_, GetEnclosingMsg()); 51 } 52 } 53 54 private: 55 parser::MessageFixedText GetEnclosingMsg() { 56 return "Enclosing CRITICAL statement"_en_US; 57 } 58 59 SemanticsContext &context_; 60 std::set<parser::Label> labels_; 61 parser::CharBlock currentStatementSourcePosition_; 62 parser::CharBlock criticalSourcePosition_; 63 }; 64 65 template <typename T> 66 static void CheckTeamType(SemanticsContext &context, const T &x) { 67 if (const auto *expr{GetExpr(x)}) { 68 if (!IsTeamType(evaluate::GetDerivedTypeSpec(expr->GetType()))) { 69 context.Say(parser::FindSourceLocation(x), // C1114 70 "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US); 71 } 72 } 73 } 74 75 void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) { 76 CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t)); 77 CheckTeamType(context_, std::get<parser::TeamValue>(x.t)); 78 } 79 80 void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) { 81 CheckTeamType(context_, std::get<parser::TeamValue>(x.t)); 82 } 83 84 void CoarrayChecker::Leave(const parser::ImageSelectorSpec &x) { 85 if (const auto *team{std::get_if<parser::TeamValue>(&x.u)}) { 86 CheckTeamType(context_, *team); 87 } 88 } 89 90 void CoarrayChecker::Leave(const parser::FormTeamStmt &x) { 91 CheckTeamType(context_, std::get<parser::TeamVariable>(x.t)); 92 } 93 94 void CoarrayChecker::Enter(const parser::CriticalConstruct &x) { 95 auto &criticalStmt{std::get<parser::Statement<parser::CriticalStmt>>(x.t)}; 96 97 const parser::Block &block{std::get<parser::Block>(x.t)}; 98 CriticalBodyEnforce criticalBodyEnforce{context_, criticalStmt.source}; 99 parser::Walk(block, criticalBodyEnforce); 100 101 // C1119 102 LabelEnforce criticalLabelEnforce{ 103 context_, criticalBodyEnforce.labels(), criticalStmt.source, "CRITICAL"}; 104 parser::Walk(block, criticalLabelEnforce); 105 } 106 107 // Check that coarray names and selector names are all distinct. 108 void CoarrayChecker::CheckNamesAreDistinct( 109 const std::list<parser::CoarrayAssociation> &list) { 110 std::set<parser::CharBlock> names; 111 auto getPreviousUse{ 112 [&](const parser::Name &name) -> const parser::CharBlock * { 113 auto pair{names.insert(name.source)}; 114 return !pair.second ? &*pair.first : nullptr; 115 }}; 116 for (const auto &assoc : list) { 117 const auto &decl{std::get<parser::CodimensionDecl>(assoc.t)}; 118 const auto &selector{std::get<parser::Selector>(assoc.t)}; 119 const auto &declName{std::get<parser::Name>(decl.t)}; 120 if (context_.HasError(declName)) { 121 continue; // already reported an error about this name 122 } 123 if (auto *prev{getPreviousUse(declName)}) { 124 Say2(declName.source, // C1113 125 "Coarray '%s' was already used as a selector or coarray in this statement"_err_en_US, 126 *prev, "Previous use of '%s'"_en_US); 127 } 128 // ResolveNames verified the selector is a simple name 129 const parser::Name *name{parser::Unwrap<parser::Name>(selector)}; 130 if (name) { 131 if (auto *prev{getPreviousUse(*name)}) { 132 Say2(name->source, // C1113, C1115 133 "Selector '%s' was already used as a selector or coarray in this statement"_err_en_US, 134 *prev, "Previous use of '%s'"_en_US); 135 } 136 } 137 } 138 } 139 140 void CoarrayChecker::Say2(const parser::CharBlock &name1, 141 parser::MessageFixedText &&msg1, const parser::CharBlock &name2, 142 parser::MessageFixedText &&msg2) { 143 context_.Say(name1, std::move(msg1), name1) 144 .Attach(name2, std::move(msg2), name2); 145 } 146 } // namespace Fortran::semantics 147