diff options
Diffstat (limited to 'flang/lib/Semantics/check-omp-structure.cpp')
| -rw-r--r-- | flang/lib/Semantics/check-omp-structure.cpp | 703 | 
1 files changed, 363 insertions, 340 deletions
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index aaaf1ec..d7db15d 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -179,29 +179,21 @@ void OmpStructureChecker::Leave(const parser::BlockConstruct &x) {    }  } -// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'. -#define CHECK_SIMPLE_CLAUSE(X, Y) \ -  void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \ -    CheckAllowedClause(llvm::omp::Clause::Y); \ -  } +void OmpStructureChecker::Enter(const parser::SpecificationPart &) { +  partStack_.push_back(PartKind::SpecificationPart); +} -#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \ -  void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \ -    CheckAllowedClause(llvm::omp::Clause::Y); \ -    RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \ -  } +void OmpStructureChecker::Leave(const parser::SpecificationPart &) { +  partStack_.pop_back(); +} -#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \ -  void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \ -    CheckAllowedClause(llvm::omp::Clause::Y); \ -    RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \ -  } +void OmpStructureChecker::Enter(const parser::ExecutionPart &) { +  partStack_.push_back(PartKind::ExecutionPart); +} -// Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'. -#define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \ -  void OmpStructureChecker::Enter(const parser::X &) { \ -    CheckAllowedClause(llvm::omp::Y); \ -  } +void OmpStructureChecker::Leave(const parser::ExecutionPart &) { +  partStack_.pop_back(); +}  // 'OmpWorkshareBlockChecker' is used to check the validity of the assignment  // statements and the expressions enclosed in an OpenMP Workshare construct @@ -667,49 +659,6 @@ void OmpStructureChecker::HasInvalidTeamsNesting(    }  } -void OmpStructureChecker::CheckPredefinedAllocatorRestriction( -    const parser::CharBlock &source, const parser::Name &name) { -  if (const auto *symbol{name.symbol}) { -    const auto *commonBlock{FindCommonBlockContaining(*symbol)}; -    const auto &scope{context_.FindScope(symbol->name())}; -    const Scope &containingScope{GetProgramUnitContaining(scope)}; -    if (!isPredefinedAllocator && -        (IsSaved(*symbol) || commonBlock || -            containingScope.kind() == Scope::Kind::Module)) { -      context_.Say(source, -          "If list items within the %s directive have the " -          "SAVE attribute, are a common block name, or are " -          "declared in the scope of a module, then only " -          "predefined memory allocator parameters can be used " -          "in the allocator clause"_err_en_US, -          ContextDirectiveAsFortran()); -    } -  } -} - -void OmpStructureChecker::CheckPredefinedAllocatorRestriction( -    const parser::CharBlock &source, -    const parser::OmpObjectList &ompObjectList) { -  for (const auto &ompObject : ompObjectList.v) { -    common::visit( -        common::visitors{ -            [&](const parser::Designator &designator) { -              if (const auto *dataRef{ -                      std::get_if<parser::DataRef>(&designator.u)}) { -                if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) { -                  CheckPredefinedAllocatorRestriction(source, *name); -                } -              } -            }, -            [&](const parser::Name &name) { -              CheckPredefinedAllocatorRestriction(source, name); -            }, -            [&](const parser::OmpObject::Invalid &invalid) {}, -        }, -        ompObject.u); -  } -} -  void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {    CheckAllowedClause(llvm::omp::Clause::OMPC_hint);    auto &dirCtx{GetContext()}; @@ -763,18 +712,10 @@ template <typename Checker> struct DirectiveSpellingVisitor {      return std::get<parser::OmpBeginDirective>(t).DirName();    } -  bool Pre(const parser::OpenMPDeclarativeAllocate &x) { -    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate); -    return false; -  }    bool Pre(const parser::OpenMPDispatchConstruct &x) {      checker_(GetDirName(x.t).source, Directive::OMPD_dispatch);      return false;    } -  bool Pre(const parser::OpenMPExecutableAllocate &x) { -    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate); -    return false; -  }    bool Pre(const parser::OpenMPAllocatorsConstruct &x) {      checker_(GetDirName(x.t).source, Directive::OMPD_allocators);      return false; @@ -1710,12 +1651,39 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {    dirContext_.pop_back();  } -void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, -    const parser::OmpObjectList &objects, -    const parser::OmpClauseList &clauses) { -  const Scope &thisScope{context_.FindScope(source)}; -  SymbolSourceMap symbols; -  GetSymbolsInObjectList(objects, symbols); +static std::pair<const parser::AllocateStmt *, parser::CharBlock> +getAllocateStmtAndSource(const parser::ExecutionPartConstruct *epc) { +  if (SourcedActionStmt as{GetActionStmt(epc)}) { +    using IndirectionAllocateStmt = common::Indirection<parser::AllocateStmt>; +    if (auto *indirect{std::get_if<IndirectionAllocateStmt>(&as.stmt->u)}) { +      return {&indirect->value(), as.source}; +    } +  } +  return {nullptr, ""}; +} + +// Collect symbols that correspond to non-component objects on the +// ALLOCATE statement. +static UnorderedSymbolSet GetNonComponentSymbols( +    const parser::AllocateStmt &stmt) { +  UnorderedSymbolSet symbols; +  for (auto &alloc : std::get<std::list<parser::Allocation>>(stmt.t)) { +    auto &object{std::get<parser::AllocateObject>(alloc.t)}; +    if (auto *name{std::get_if<parser::Name>(&object.u)}) { +      if (name->symbol) { +        symbols.insert(name->symbol->GetUltimate()); +      } +    } +  } +  return symbols; +} + +void OmpStructureChecker::CheckIndividualAllocateDirective( +    const parser::OmpAllocateDirective &x, bool isExecutable) { +  const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; +  const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; + +  const Scope &thisScope{context_.FindScope(dirName.source)};    auto maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) {      // Return "true" if the ALLOCATOR clause was provided with an argument @@ -1741,73 +1709,200 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,      return true;    }}; -  const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)}; +  const auto *allocator{[&]() { +    // Can't use FindClause in Enter (because clauses haven't been visited +    // yet). +    for (const parser::OmpClause &c : beginSpec.Clauses().v) { +      if (c.Id() == llvm::omp::Clause::OMPC_allocator) { +        return &c; +      } +    } +    return static_cast<const parser::OmpClause *>(nullptr); +  }()}; +    if (InTargetRegion()) {      bool hasDynAllocators{          HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};      if (!allocator && !hasDynAllocators) { -      context_.Say(source, +      context_.Say(dirName.source,            "An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);      }    }    auto maybePredefined{maybeHasPredefinedAllocator(allocator)}; -  for (auto &[symbol, source] : symbols) { -    if (!inExecutableAllocate_) { -      if (symbol->owner() != thisScope) { +  unsigned version{context_.langOptions().OpenMPVersion}; +  std::string condStr{version == 50 +          ? "a named common block, has SAVE attribute or is declared in the " +            "scope of a module" +          : "a named common block or has SAVE attribute"}; + +  auto checkSymbol{[&](const Symbol &symbol, parser::CharBlock source) { +    if (!isExecutable) { +      // For structure members, the scope is the derived type, which is +      // never "this" scope. Ignore this check for members, they will be +      // flagged anyway. +      if (symbol.owner() != thisScope && !IsStructureComponent(symbol)) {          context_.Say(source,              "A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears"_err_en_US);        } -      if (IsPointer(*symbol) || IsAllocatable(*symbol)) { +      if (IsPointer(symbol) || IsAllocatable(symbol)) {          context_.Say(source,              "A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute"_err_en_US);        }      } -    if (symbol->GetUltimate().has<AssocEntityDetails>()) { +    if (symbol.GetUltimate().has<AssocEntityDetails>()) {        context_.Say(source,            "A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US);      } -    if (symbol->attrs().test(Attr::SAVE) || IsCommonBlock(*symbol)) { +    bool inModule{ +        version == 50 && symbol.owner().kind() == Scope::Kind::Module}; +    if (symbol.attrs().test(Attr::SAVE) || IsCommonBlock(symbol) || inModule) {        if (!allocator) {          context_.Say(source, -            "If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US); +            "If a list item is %s, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US, +            condStr);        } else if (!maybePredefined) {          context_.Say(source, -            "If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause"_err_en_US); +            "If a list item is %s, only a predefined allocator may be used on the ALLOCATOR clause"_err_en_US, +            condStr);        }      } -    if (FindCommonBlockContaining(*symbol)) { +    if (FindCommonBlockContaining(symbol)) {        context_.Say(source,            "A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block"_err_en_US);      } +  }}; + +  for (const parser::OmpArgument &arg : beginSpec.Arguments().v) { +    const parser::OmpObject *object{GetArgumentObject(arg)}; +    if (!object) { +      context_.Say(arg.source, +          "An argument to ALLOCATE directive must be a variable list item"_err_en_US); +      continue; +    } + +    if (const Symbol *symbol{GetObjectSymbol(*object)}) { +      if (!IsTypeParamInquiry(*symbol)) { +        checkSymbol(*symbol, arg.source); +      } +      CheckVarIsNotPartOfAnotherVar(dirName.source, *object); +    }    } -  CheckVarIsNotPartOfAnotherVar(source, objects);  } -void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { -  const auto &dir{std::get<parser::Verbatim>(x.t)}; -  PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); +void OmpStructureChecker::CheckExecutableAllocateDirective( +    const parser::OmpAllocateDirective &x) { +  parser::omp::OmpAllocateInfo info{SplitOmpAllocate(x)}; + +  auto [allocStmt, allocSource]{getAllocateStmtAndSource(info.body)}; +  if (!allocStmt) { +    // This has been diagnosed already. +    return; +  } + +  UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; +  SymbolSourceMap directiveSyms; +  bool hasEmptyList{false}; + +  for (const parser::OmpAllocateDirective *ompAlloc : info.dirs) { +    const parser::OmpDirectiveSpecification &spec{DEREF(ompAlloc).BeginDir()}; +    if (spec.Arguments().v.empty()) { +      if (hasEmptyList && info.dirs.size() > 1) { +        context_.Say(spec.DirName().source, +            "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US); +      } +      hasEmptyList = true; +    } +    for (const parser::OmpArgument &arg : spec.Arguments().v) { +      if (auto *sym{GetArgumentSymbol(arg)}) { +        // Ignore these checks for structure members. They are not allowed +        // in the first place, so don't tell the users that they need to +        // be specified somewhere, +        if (IsStructureComponent(*sym)) { +          continue; +        } +        if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) { +          parser::MessageFormattedText txt( +              "A list item on an executable ALLOCATE may only be specified once"_err_en_US); +          parser::Message message(arg.source, txt); +          message.Attach(f->second, "The list item was specified here"_en_US); +          context_.Say(std::move(message)); +        } else { +          directiveSyms.insert(std::make_pair(sym, arg.source)); +        } + +        if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) { +          context_ +              .Say(arg.source, +                  "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US) +              .Attach(allocSource, "The ALLOCATE statement"_en_US); +        } +      } +    } +  }  } -void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { -  if (!inExecutableAllocate_) { -    const auto &dir{std::get<parser::Verbatim>(x.t)}; -    const auto &clauseList{std::get<parser::OmpClauseList>(x.t)}; -    const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; +void OmpStructureChecker::Enter(const parser::OmpAllocateDirective &x) { +  const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; +  const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; +  PushContextAndClauseSets(dirName.source, dirName.v); +  ++allocateDirectiveLevel; -    isPredefinedAllocator = true; -    CheckAllocateDirective(dir.source, objectList, clauseList); +  bool isExecutable{partStack_.back() == PartKind::ExecutionPart}; + +  unsigned version{context_.langOptions().OpenMPVersion}; +  if (isExecutable && allocateDirectiveLevel == 1 && version >= 52) { +    context_.Warn(common::UsageWarning::OpenMPUsage, dirName.source, +        "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US);    } + +  CheckIndividualAllocateDirective(x, isExecutable); + +  if (isExecutable) { +    auto isOmpAllocate{[](const parser::ExecutionPartConstruct &epc) { +      if (auto *omp{GetOmp(epc)}) { +        auto odn{GetOmpDirectiveName(*omp)}; +        return odn.v == llvm::omp::Directive::OMPD_allocate; +      } +      return false; +    }}; + +    auto &body{std::get<parser::Block>(x.t)}; +    // The parser should put at most one statement in the body. +    assert(body.size() <= 1 && "Multiple statements in allocate"); +    if (body.empty()) { +      context_.Say(dirName.source, +          "An executable ALLOCATE directive must be associated with an ALLOCATE statement"_err_en_US); +    } else { +      const parser::ExecutionPartConstruct &first{body.front()}; +      auto [allocStmt, _]{getAllocateStmtAndSource(&body.front())}; +      if (!isOmpAllocate(first) && !allocStmt) { +        parser::CharBlock source{[&]() { +          if (auto &&maybeSource{parser::GetSource(first)}) { +            return *maybeSource; +          } +          return dirName.source; +        }()}; +        context_.Say(source, +            "The statement associated with executable ALLOCATE directive must be an ALLOCATE statement"_err_en_US); +      } +    } +  } +} + +void OmpStructureChecker::Leave(const parser::OmpAllocateDirective &x) { +  bool isExecutable{partStack_.back() == PartKind::ExecutionPart}; +  if (isExecutable && allocateDirectiveLevel == 1) { +    CheckExecutableAllocateDirective(x); +  } + +  --allocateDirectiveLevel;    dirContext_.pop_back();  }  void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {    CheckAllowedClause(llvm::omp::Clause::OMPC_allocator); -  // Note: Predefined allocators are stored in ScalarExpr as numbers -  //   whereas custom allocators are stored as strings, so if the ScalarExpr -  //   actually has an int value, then it must be a predefined allocator -  isPredefinedAllocator = GetIntValue(x.v).has_value();    RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);  } @@ -1823,16 +1918,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {              "The alignment value should be a constant positive integer"_err_en_US);        }      } -    // The simple and complex modifiers have the same structure. They only -    // differ in their syntax. -    if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorComplexModifier>( -            modifiers)}) { -      isPredefinedAllocator = GetIntValue(alloc->v).has_value(); -    } -    if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorSimpleModifier>( -            modifiers)}) { -      isPredefinedAllocator = GetIntValue(alloc->v).has_value(); -    }    }  } @@ -2115,168 +2200,88 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {    }  } -// Goes through the names in an OmpObjectList and checks if each name appears -// in the given allocate statement -void OmpStructureChecker::CheckAllNamesInAllocateStmt( -    const parser::CharBlock &source, const parser::OmpObjectList &ompObjectList, -    const parser::AllocateStmt &allocate) { -  for (const auto &obj : ompObjectList.v) { -    if (const auto *d{std::get_if<parser::Designator>(&obj.u)}) { -      if (const auto *ref{std::get_if<parser::DataRef>(&d->u)}) { -        if (const auto *n{std::get_if<parser::Name>(&ref->u)}) { -          CheckNameInAllocateStmt(source, *n, allocate); -        } -      } -    } -  } -} - -void OmpStructureChecker::CheckNameInAllocateStmt( -    const parser::CharBlock &source, const parser::Name &name, -    const parser::AllocateStmt &allocate) { -  for (const auto &allocation : -      std::get<std::list<parser::Allocation>>(allocate.t)) { -    const auto &allocObj = std::get<parser::AllocateObject>(allocation.t); -    if (const auto *n{std::get_if<parser::Name>(&allocObj.u)}) { -      if (n->source == name.source) { -        return; -      } -    } -  } -  unsigned version{context_.langOptions().OpenMPVersion}; -  context_.Say(source, -      "Object '%s' in %s directive not " -      "found in corresponding ALLOCATE statement"_err_en_US, -      name.ToString(), -      parser::ToUpperCaseLetters( -          llvm::omp::getOpenMPDirectiveName(GetContext().directive, version) -              .str())); -} - -void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { -  inExecutableAllocate_ = true; -  const auto &dir{std::get<parser::Verbatim>(x.t)}; -  PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); - -  unsigned version{context_.langOptions().OpenMPVersion}; -  if (version >= 52) { -    context_.Warn(common::UsageWarning::OpenMPUsage, x.source, -        "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US); -  } - -  const auto &allocateStmt = -      std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement; -  if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) { -    CheckAllNamesInAllocateStmt( -        std::get<parser::Verbatim>(x.t).source, *list, allocateStmt); -  } -  if (const auto &subDirs{ -          std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>( -              x.t)}) { -    for (const auto &dalloc : *subDirs) { -      CheckAllNamesInAllocateStmt(std::get<parser::Verbatim>(dalloc.t).source, -          std::get<parser::OmpObjectList>(dalloc.t), allocateStmt); -    } -  } - -  isPredefinedAllocator = true; -} +void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { +  const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; +  const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; +  PushContextAndClauseSets( +      dirName.source, llvm::omp::Directive::OMPD_allocators); -void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { -  parser::OmpObjectList empty{std::list<parser::OmpObject>{}}; -  auto &objects{[&]() -> const parser::OmpObjectList & { -    if (auto &objects{std::get<std::optional<parser::OmpObjectList>>(x.t)}) { -      return *objects; -    } else { -      return empty; +  for (const auto &clause : beginSpec.Clauses().v) { +    auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)}; +    if (!alloc) { +      continue;      } -  }()}; -  auto &clauses{std::get<parser::OmpClauseList>(x.t)}; -  CheckAllocateDirective( -      std::get<parser::Verbatim>(x.t).source, objects, clauses); - -  if (const auto &subDirs{ -          std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>( -              x.t)}) { -    for (const auto &dalloc : *subDirs) { -      const auto &dir{std::get<parser::Verbatim>(x.t)}; -      const auto &clauses{std::get<parser::OmpClauseList>(dalloc.t)}; -      const auto &objects{std::get<parser::OmpObjectList>(dalloc.t)}; -      CheckAllocateDirective(dir.source, objects, clauses); +    using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier; +    using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier; + +    if (InTargetRegion()) { +      auto &modifiers{OmpGetModifiers(alloc->v)}; +      bool hasAllocator{ +          OmpGetUniqueModifier<OmpAllocatorSimpleModifier>(modifiers) || +          OmpGetUniqueModifier<OmpAllocatorComplexModifier>(modifiers)}; +      bool hasDynAllocators{ +          HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)}; +      if (!hasAllocator && !hasDynAllocators) { +        context_.Say(clause.source, +            "An ALLOCATE clause in a TARGET region must specify an allocator or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US); +      }      }    } -  dirContext_.pop_back(); -  inExecutableAllocate_ = false; -} - -void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { -  isPredefinedAllocator = true; - -  const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()}; -  auto &block{std::get<parser::Block>(x.t)}; -  PushContextAndClauseSets( -      dirSpec.DirName().source, llvm::omp::Directive::OMPD_allocators); - -  if (block.empty()) { -    context_.Say(dirSpec.source, -        "The ALLOCATORS construct should contain a single ALLOCATE statement"_err_en_US); +  auto &body{std::get<parser::Block>(x.t)}; +  // The parser should put at most one statement in the body. +  assert(body.size() <= 1 && "Malformed body in allocators"); +  if (body.empty()) { +    context_.Say(dirName.source, +        "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);      return;    } -  omp::SourcedActionStmt action{omp::GetActionStmt(block)}; -  const auto *allocate{ -      action ? parser::Unwrap<parser::AllocateStmt>(action.stmt) : nullptr}; - -  if (allocate) { -    for (const auto &clause : dirSpec.Clauses().v) { -      if (auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)}) { -        CheckAllNamesInAllocateStmt( -            x.source, std::get<parser::OmpObjectList>(alloc->v.t), *allocate); - -        using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier; -        using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier; - -        auto &modifiers{OmpGetModifiers(alloc->v)}; -        bool hasAllocator{ -            OmpGetUniqueModifier<OmpAllocatorSimpleModifier>(modifiers) || -            OmpGetUniqueModifier<OmpAllocatorComplexModifier>(modifiers)}; - -        // TODO: As with allocate directive, exclude the case when a requires -        //       directive with the dynamic_allocators clause is present in -        //       the same compilation unit (OMP5.0 2.11.3). -        if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && -            !hasAllocator) { -          context_.Say(x.source, -              "ALLOCATORS directives that appear in a TARGET region must specify an allocator"_err_en_US); -        } +  auto [allocStmt, allocSource]{getAllocateStmtAndSource(&body.front())}; +  if (!allocStmt) { +    parser::CharBlock source{[&]() { +      if (auto &&maybeSource{parser::GetSource(body.front())}) { +        return *maybeSource;        } -    } -  } else { -    const parser::CharBlock &source = action ? action.source : x.source; +      return dirName.source; +    }()};      context_.Say(source, -        "The body of the ALLOCATORS construct should be an ALLOCATE statement"_err_en_US); +        "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US); +    return;    } -  for (const auto &clause : dirSpec.Clauses().v) { -    if (const auto *allocClause{ -            parser::Unwrap<parser::OmpClause::Allocate>(clause)}) { -      CheckVarIsNotPartOfAnotherVar( -          dirSpec.source, std::get<parser::OmpObjectList>(allocClause->v.t)); +  UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; +  for (const auto &clause : beginSpec.Clauses().v) { +    auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)}; +    if (!alloc) { +      continue; +    } +    for (auto &object : DEREF(GetOmpObjectList(clause)).v) { +      CheckVarIsNotPartOfAnotherVar(dirName.source, object); +      if (auto *symbol{GetObjectSymbol(object)}) { +        if (IsStructureComponent(*symbol)) { +          continue; +        } +        parser::CharBlock source{[&]() { +          if (auto &&objectSource{GetObjectSource(object)}) { +            return *objectSource; +          } +          return clause.source; +        }()}; +        if (!IsTypeParamInquiry(*symbol)) { +          if (auto f{allocateSyms.find(*symbol)}; f == allocateSyms.end()) { +            context_ +                .Say(source, +                    "A list item in an ALLOCATORS construct must be specified on the associated ALLOCATE statement"_err_en_US) +                .Attach(allocSource, "The ALLOCATE statement"_en_US); +          } +        } +      }      }    }  }  void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) { -  const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()}; - -  for (const auto &clause : dirSpec.Clauses().v) { -    if (const auto *allocClause{ -            std::get_if<parser::OmpClause::Allocate>(&clause.u)}) { -      CheckPredefinedAllocatorRestriction( -          dirSpec.source, std::get<parser::OmpObjectList>(allocClause->v.t)); -    } -  }    dirContext_.pop_back();  } @@ -3362,88 +3367,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Sizes &c) {          /*paramName=*/"parameter", /*allowZero=*/false);  } -// Following clauses do not have a separate node in parse-tree.h. -CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent) -CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity) -CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture) -CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains) -CHECK_SIMPLE_CLAUSE(Default, OMPC_default) -CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj) -CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type) -CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule) -CHECK_SIMPLE_CLAUSE(DynGroupprivate, OMPC_dyn_groupprivate) -CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive) -CHECK_SIMPLE_CLAUSE(Final, OMPC_final) -CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush) -CHECK_SIMPLE_CLAUSE(Full, OMPC_full) -CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize) -CHECK_SIMPLE_CLAUSE(GraphId, OMPC_graph_id) -CHECK_SIMPLE_CLAUSE(GraphReset, OMPC_graph_reset) -CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds) -CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive) -CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer) -CHECK_SIMPLE_CLAUSE(Match, OMPC_match) -CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal) -CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks) -CHECK_SIMPLE_CLAUSE(Order, OMPC_order) -CHECK_SIMPLE_CLAUSE(Read, OMPC_read) -CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate) -CHECK_SIMPLE_CLAUSE(Groupprivate, OMPC_groupprivate) -CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads) -CHECK_SIMPLE_CLAUSE(Threadset, OMPC_threadset) -CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) -CHECK_SIMPLE_CLAUSE(Link, OMPC_link) -CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect) -CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable) -CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp) -CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines) -CHECK_SIMPLE_CLAUSE(NoOpenmpConstructs, OMPC_no_openmp_constructs) -CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism) -CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup) -CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch) -CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial) -CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind) -CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd) -CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation) -CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) -CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown) -CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied) -CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators) -CHECK_SIMPLE_CLAUSE(Write, OMPC_write) -CHECK_SIMPLE_CLAUSE(Init, OMPC_init) -CHECK_SIMPLE_CLAUSE(Use, OMPC_use) -CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants) -CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext) -CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity) -CHECK_SIMPLE_CLAUSE(Message, OMPC_message) -CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) -CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise) -CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args) -CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args) -CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order) -CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind) -CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare) -CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute) -CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak) -CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel) -CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire) -CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed) -CHECK_SIMPLE_CLAUSE(Release, OMPC_release) -CHECK_SIMPLE_CLAUSE(Replayable, OMPC_replayable) -CHECK_SIMPLE_CLAUSE(Transparent, OMPC_transparent) -CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) -CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail) - -CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams) -CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads) -CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem) -CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority) -CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit) - -CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse) -CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen) -CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen) -  void OmpStructureChecker::Enter(const parser::OmpClause::Looprange &x) {    context_.Say(GetContext().clauseSource,        "LOOPRANGE clause is not implemented yet"_err_en_US, @@ -5516,4 +5439,104 @@ void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {    }  } +// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'. +#define CHECK_SIMPLE_CLAUSE(X, Y) \ +  void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \ +    CheckAllowedClause(llvm::omp::Clause::Y); \ +  } + +#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \ +  void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \ +    CheckAllowedClause(llvm::omp::Clause::Y); \ +    RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \ +  } + +#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \ +  void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \ +    CheckAllowedClause(llvm::omp::Clause::Y); \ +    RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \ +  } + +// Following clauses do not have a separate node in parse-tree.h. +CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent) +CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel) +CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire) +CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args) +CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity) +CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args) +CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind) +CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture) +CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare) +CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains) +CHECK_SIMPLE_CLAUSE(Default, OMPC_default) +CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj) +CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type) +CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule) +CHECK_SIMPLE_CLAUSE(DynGroupprivate, OMPC_dyn_groupprivate) +CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive) +CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail) +CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) +CHECK_SIMPLE_CLAUSE(Final, OMPC_final) +CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush) +CHECK_SIMPLE_CLAUSE(Full, OMPC_full) +CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize) +CHECK_SIMPLE_CLAUSE(GraphId, OMPC_graph_id) +CHECK_SIMPLE_CLAUSE(GraphReset, OMPC_graph_reset) +CHECK_SIMPLE_CLAUSE(Groupprivate, OMPC_groupprivate) +CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds) +CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) +CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive) +CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect) +CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer) +CHECK_SIMPLE_CLAUSE(Init, OMPC_init) +CHECK_SIMPLE_CLAUSE(Link, OMPC_link) +CHECK_SIMPLE_CLAUSE(Match, OMPC_match) +CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order) +CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable) +CHECK_SIMPLE_CLAUSE(Message, OMPC_message) +CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext) +CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup) +CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal) +CHECK_SIMPLE_CLAUSE(NoOpenmpConstructs, OMPC_no_openmp_constructs) +CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp) +CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines) +CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism) +CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch) +CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants) +CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks) +CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute) +CHECK_SIMPLE_CLAUSE(Order, OMPC_order) +CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise) +CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial) +CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation) +CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind) +CHECK_SIMPLE_CLAUSE(Read, OMPC_read) +CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed) +CHECK_SIMPLE_CLAUSE(Release, OMPC_release) +CHECK_SIMPLE_CLAUSE(Replayable, OMPC_replayable) +CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) +CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity) +CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd) +CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate) +CHECK_SIMPLE_CLAUSE(Threadset, OMPC_threadset) +CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads) +CHECK_SIMPLE_CLAUSE(Transparent, OMPC_transparent) +CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) +CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown) +CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied) +CHECK_SIMPLE_CLAUSE(Use, OMPC_use) +CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators) +CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak) +CHECK_SIMPLE_CLAUSE(Write, OMPC_write) + +CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams) +CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads) +CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem) +CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority) +CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit) + +CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse) +CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen) +CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen) +  } // namespace Fortran::semantics  | 
