flang/lib/Semantics/check-coarray.cpp

   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(context, 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 static void CheckTeamStat(
  76     SemanticsContext &context, const parser::ImageSelectorSpec::Stat &stat) {
  77   const parser::Variable &var{stat.v.thing.thing.value()};
  78   if (parser::GetCoindexedNamedObject(var)) {
  79     context.Say(parser::FindSourceLocation(var), // C931
  80         "Image selector STAT variable must not be a coindexed "
  81         "object"_err_en_US);
  82   }
  83 }
  84
  85 static void CheckCoindexedStatOrErrmsg(SemanticsContext &context,
  86     const parser::StatOrErrmsg &statOrErrmsg, const std::string &listName) {
  87   auto CoindexedCheck{[&](const auto &statOrErrmsg) {
  88     if (const auto *expr{GetExpr(context, statOrErrmsg)}) {
  89       if (ExtractCoarrayRef(expr)) {
  90         context.Say(parser::FindSourceLocation(statOrErrmsg), // C1173
  91             "The stat-variable or errmsg-variable in a %s may not be a coindexed object"_err_en_US,
  92             listName);
  93       }
  94     }
  95   }};
  96   std::visit(CoindexedCheck, statOrErrmsg.u);
  97 }
  98
  99 static void CheckSyncStatList(
 100     SemanticsContext &context, const std::list<parser::StatOrErrmsg> &list) {
 101   bool gotStat{false}, gotMsg{false};
 102
 103   for (const parser::StatOrErrmsg &statOrErrmsg : list) {
 104     common::visit(
 105         common::visitors{
 106             [&](const parser::StatVariable &stat) {
 107               if (gotStat) {
 108                 context.Say( // C1172
 109                     "The stat-variable in a sync-stat-list may not be repeated"_err_en_US);
 110               }
 111               gotStat = true;
 112             },
 113             [&](const parser::MsgVariable &errmsg) {
 114               if (gotMsg) {
 115                 context.Say( // C1172
 116                     "The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US);
 117               }
 118               gotMsg = true;
 119             },
 120         },
 121         statOrErrmsg.u);
 122
 123     CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list");
 124   }
 125 }
 126
 127 void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) {
 128   CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t));
 129   CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 130 }
 131
 132 void CoarrayChecker::Leave(const parser::SyncAllStmt &x) {
 133   CheckSyncStatList(context_, x.v);
 134 }
 135
 136 void CoarrayChecker::Leave(const parser::SyncImagesStmt &x) {
 137   CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
 138
 139   const auto &imageSet{std::get<parser::SyncImagesStmt::ImageSet>(x.t)};
 140   if (const auto *intExpr{std::get_if<parser::IntExpr>(&imageSet.u)}) {
 141     if (const auto *expr{GetExpr(context_, *intExpr)}) {
 142       if (expr->Rank() > 1) {
 143         context_.Say(parser::FindSourceLocation(imageSet), // C1174
 144             "An image-set that is an int-expr must be a scalar or a rank-one array"_err_en_US);
 145       }
 146     }
 147   }
 148 }
 149
 150 void CoarrayChecker::Leave(const parser::SyncMemoryStmt &x) {
 151   CheckSyncStatList(context_, x.v);
 152 }
 153
 154 void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) {
 155   CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 156   CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
 157 }
 158
 159 void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) {
 160   haveStat_ = false;
 161   haveTeam_ = false;
 162   haveTeamNumber_ = false;
 163   for (const auto &imageSelectorSpec :
 164       std::get<std::list<parser::ImageSelectorSpec>>(imageSelector.t)) {
 165     if (const auto *team{
 166             std::get_if<parser::TeamValue>(&imageSelectorSpec.u)}) {
 167       if (haveTeam_) {
 168         context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
 169             "TEAM value can only be specified once"_err_en_US);
 170       }
 171       CheckTeamType(context_, *team);
 172       haveTeam_ = true;
 173     }
 174     if (const auto *stat{std::get_if<parser::ImageSelectorSpec::Stat>(
 175             &imageSelectorSpec.u)}) {
 176       if (haveStat_) {
 177         context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
 178             "STAT variable can only be specified once"_err_en_US);
 179       }
 180       CheckTeamStat(context_, *stat);
 181       haveStat_ = true;
 182     }
 183     if (std::get_if<parser::ImageSelectorSpec::Team_Number>(
 184             &imageSelectorSpec.u)) {
 185       if (haveTeamNumber_) {
 186         context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
 187             "TEAM_NUMBER value can only be specified once"_err_en_US);
 188       }
 189       haveTeamNumber_ = true;
 190     }
 191   }
 192   if (haveTeam_ && haveTeamNumber_) {
 193     context_.Say(parser::FindSourceLocation(imageSelector), // C930
 194         "Cannot specify both TEAM and TEAM_NUMBER"_err_en_US);
 195   }
 196 }
 197
 198 void CoarrayChecker::Leave(const parser::FormTeamStmt &x) {
 199   CheckTeamType(context_, std::get<parser::TeamVariable>(x.t));
 200 }
 201
 202 void CoarrayChecker::Enter(const parser::CriticalConstruct &x) {
 203   auto &criticalStmt{std::get<parser::Statement<parser::CriticalStmt>>(x.t)};
 204
 205   const parser::Block &block{std::get<parser::Block>(x.t)};
 206   CriticalBodyEnforce criticalBodyEnforce{context_, criticalStmt.source};
 207   parser::Walk(block, criticalBodyEnforce);
 208
 209   // C1119
 210   LabelEnforce criticalLabelEnforce{
 211       context_, criticalBodyEnforce.labels(), criticalStmt.source, "CRITICAL"};
 212   parser::Walk(block, criticalLabelEnforce);
 213 }
 214
 215 // Check that coarray names and selector names are all distinct.
 216 void CoarrayChecker::CheckNamesAreDistinct(
 217     const std::list<parser::CoarrayAssociation> &list) {
 218   std::set<parser::CharBlock> names;
 219   auto getPreviousUse{
 220       [&](const parser::Name &name) -> const parser::CharBlock * {
 221         auto pair{names.insert(name.source)};
 222         return !pair.second ? &*pair.first : nullptr;
 223       }};
 224   for (const auto &assoc : list) {
 225     const auto &decl{std::get<parser::CodimensionDecl>(assoc.t)};
 226     const auto &selector{std::get<parser::Selector>(assoc.t)};
 227     const auto &declName{std::get<parser::Name>(decl.t)};
 228     if (context_.HasError(declName)) {
 229       continue; // already reported an error about this name
 230     }
 231     if (auto *prev{getPreviousUse(declName)}) {
 232       Say2(declName.source, // C1113
 233           "Coarray '%s' was already used as a selector or coarray in this statement"_err_en_US,
 234           *prev, "Previous use of '%s'"_en_US);
 235     }
 236     // ResolveNames verified the selector is a simple name
 237     const parser::Name *name{parser::Unwrap<parser::Name>(selector)};
 238     if (name) {
 239       if (auto *prev{getPreviousUse(*name)}) {
 240         Say2(name->source, // C1113, C1115
 241             "Selector '%s' was already used as a selector or coarray in this statement"_err_en_US,
 242             *prev, "Previous use of '%s'"_en_US);
 243       }
 244     }
 245   }
 246 }
 247
 248 void CoarrayChecker::Say2(const parser::CharBlock &name1,
 249     parser::MessageFixedText &&msg1, const parser::CharBlock &name2,
 250     parser::MessageFixedText &&msg2) {
 251   context_.Say(name1, std::move(msg1), name1)
 252       .Attach(name2, std::move(msg2), name2);
 253 }
 254 } // namespace Fortran::semantics