aboutsummaryrefslogtreecommitdiff
path: root/flang/lib/Semantics
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Semantics')
-rw-r--r--flang/lib/Semantics/check-omp-atomic.cpp2
-rw-r--r--flang/lib/Semantics/check-omp-loop.cpp2
-rw-r--r--flang/lib/Semantics/check-omp-metadirective.cpp3
-rw-r--r--flang/lib/Semantics/check-omp-structure.cpp124
-rw-r--r--flang/lib/Semantics/openmp-utils.cpp2
-rw-r--r--flang/lib/Semantics/openmp-utils.h81
-rw-r--r--flang/lib/Semantics/resolve-directives.cpp369
-rw-r--r--flang/lib/Semantics/resolve-names.cpp69
-rw-r--r--flang/lib/Semantics/unparse-with-symbols.cpp14
9 files changed, 297 insertions, 369 deletions
diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
index a5fdabf..fcb0f9a 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -11,13 +11,13 @@
//===----------------------------------------------------------------------===//
#include "check-omp-structure.h"
-#include "openmp-utils.h"
#include "flang/Common/indirection.h"
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/char-block.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
#include "flang/Semantics/type.h"
diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp
index 59d57a2..8dad1f5 100644
--- a/flang/lib/Semantics/check-omp-loop.cpp
+++ b/flang/lib/Semantics/check-omp-loop.cpp
@@ -13,7 +13,6 @@
#include "check-omp-structure.h"
#include "check-directive-structure.h"
-#include "openmp-utils.h"
#include "flang/Common/idioms.h"
#include "flang/Common/visit.h"
@@ -23,6 +22,7 @@
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
diff --git a/flang/lib/Semantics/check-omp-metadirective.cpp b/flang/lib/Semantics/check-omp-metadirective.cpp
index 03487da..cf5ea90 100644
--- a/flang/lib/Semantics/check-omp-metadirective.cpp
+++ b/flang/lib/Semantics/check-omp-metadirective.cpp
@@ -12,8 +12,6 @@
#include "check-omp-structure.h"
-#include "openmp-utils.h"
-
#include "flang/Common/idioms.h"
#include "flang/Common/indirection.h"
#include "flang/Common/visit.h"
@@ -21,6 +19,7 @@
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/tools.h"
#include "llvm/Frontend/OpenMP/OMP.h"
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index a9c56c3..cbe6b2c 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -10,7 +10,6 @@
#include "check-directive-structure.h"
#include "definable.h"
-#include "openmp-utils.h"
#include "resolve-names-utils.h"
#include "flang/Common/idioms.h"
@@ -27,6 +26,7 @@
#include "flang/Semantics/expression.h"
#include "flang/Semantics/openmp-directive-sets.h"
#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/symbol.h"
@@ -537,14 +537,6 @@ template <typename Checker> struct DirectiveSpellingVisitor {
checker_(x.v.source, Directive::OMPD_assume);
return false;
}
- bool Pre(const parser::OmpCriticalDirective &x) {
- checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
- return false;
- }
- bool Pre(const parser::OmpEndCriticalDirective &x) {
- checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
- return false;
- }
bool Pre(const parser::OmpMetadirectiveDirective &x) {
checker_(
std::get<parser::Verbatim>(x.t).source, Directive::OMPD_metadirective);
@@ -2034,41 +2026,87 @@ void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
}
void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
- const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
- const auto &dirSource{std::get<parser::Verbatim>(dir.t).source};
- const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
- PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical);
+ const parser::OmpBeginDirective &beginSpec{x.BeginDir()};
+ const std::optional<parser::OmpEndDirective> &endSpec{x.EndDir()};
+ PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirName().v);
+
const auto &block{std::get<parser::Block>(x.t)};
- CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
- const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
- const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
- const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)};
- if (dirName && endDirName &&
- dirName->ToString().compare(endDirName->ToString())) {
- context_
- .Say(endDirName->source,
- parser::MessageFormattedText{
- "CRITICAL directive names do not match"_err_en_US})
- .Attach(dirName->source, "should be "_en_US);
- } else if (dirName && !endDirName) {
- context_
- .Say(dirName->source,
- parser::MessageFormattedText{
- "CRITICAL directive names do not match"_err_en_US})
- .Attach(dirName->source, "should be NULL"_en_US);
- } else if (!dirName && endDirName) {
- context_
- .Say(endDirName->source,
- parser::MessageFormattedText{
- "CRITICAL directive names do not match"_err_en_US})
- .Attach(endDirName->source, "should be NULL"_en_US);
- }
- if (!dirName && !ompClause.source.empty() &&
- ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") {
- context_.Say(dir.source,
- parser::MessageFormattedText{
- "Hint clause other than omp_sync_hint_none cannot be specified for "
- "an unnamed CRITICAL directive"_err_en_US});
+ CheckNoBranching(
+ block, llvm::omp::Directive::OMPD_critical, beginSpec.DirName().source);
+
+ auto getNameFromArg{[](const parser::OmpArgument &arg) {
+ if (auto *object{parser::Unwrap<parser::OmpObject>(arg.u)}) {
+ if (auto *designator{omp::GetDesignatorFromObj(*object)}) {
+ return getDesignatorNameIfDataRef(*designator);
+ }
+ }
+ return static_cast<const parser::Name *>(nullptr);
+ }};
+
+ auto checkArgumentList{[&](const parser::OmpArgumentList &args) {
+ if (args.v.size() > 1) {
+ context_.Say(args.source,
+ "Only a single argument is allowed in CRITICAL directive"_err_en_US);
+ } else if (!args.v.empty()) {
+ if (!getNameFromArg(args.v.front())) {
+ context_.Say(args.v.front().source,
+ "CRITICAL argument should be a name"_err_en_US);
+ }
+ }
+ }};
+
+ const parser::Name *beginName{nullptr};
+ const parser::Name *endName{nullptr};
+
+ auto &beginArgs{beginSpec.Arguments()};
+ checkArgumentList(beginArgs);
+
+ if (!beginArgs.v.empty()) {
+ beginName = getNameFromArg(beginArgs.v.front());
+ }
+
+ if (endSpec) {
+ auto &endArgs{endSpec->Arguments()};
+ checkArgumentList(endArgs);
+
+ if (beginArgs.v.empty() != endArgs.v.empty()) {
+ parser::CharBlock source{
+ beginArgs.v.empty() ? endArgs.source : beginArgs.source};
+ context_.Say(source,
+ "Either both CRITICAL and END CRITICAL should have an argument, or none of them should"_err_en_US);
+ } else if (!beginArgs.v.empty()) {
+ endName = getNameFromArg(endArgs.v.front());
+ if (beginName && endName) {
+ if (beginName->ToString() != endName->ToString()) {
+ context_.Say(endName->source,
+ "The names on CRITICAL and END CRITICAL must match"_err_en_US);
+ }
+ }
+ }
+ }
+
+ for (auto &clause : beginSpec.Clauses().v) {
+ auto *hint{std::get_if<parser::OmpClause::Hint>(&clause.u)};
+ if (!hint) {
+ continue;
+ }
+ const int64_t OmpSyncHintNone = 0; // omp_sync_hint_none
+ std::optional<int64_t> hintValue{GetIntValue(hint->v.v)};
+ if (hintValue && *hintValue != OmpSyncHintNone) {
+ // Emit a diagnostic if the name is missing, and point to the directive
+ // with a missing name.
+ parser::CharBlock source;
+ if (!beginName) {
+ source = beginSpec.DirName().source;
+ } else if (endSpec && !endName) {
+ source = endSpec->DirName().source;
+ }
+
+ if (!source.empty()) {
+ context_.Say(source,
+ "When HINT other than 'omp_sync_hint_none' is present, CRITICAL directive should have a name"_err_en_US);
+ }
+ }
}
}
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 7a492a4..e8df346c 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -10,7 +10,7 @@
//
//===----------------------------------------------------------------------===//
-#include "openmp-utils.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Common/indirection.h"
#include "flang/Common/reference.h"
diff --git a/flang/lib/Semantics/openmp-utils.h b/flang/lib/Semantics/openmp-utils.h
deleted file mode 100644
index b8ad9ed..0000000
--- a/flang/lib/Semantics/openmp-utils.h
+++ /dev/null
@@ -1,81 +0,0 @@
-//===-- lib/Semantics/openmp-utils.h --------------------------------------===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-//
-// Common utilities used in OpenMP semantic checks.
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_SEMANTICS_OPENMP_UTILS_H
-#define FORTRAN_SEMANTICS_OPENMP_UTILS_H
-
-#include "flang/Evaluate/type.h"
-#include "flang/Parser/char-block.h"
-#include "flang/Parser/parse-tree.h"
-#include "flang/Semantics/tools.h"
-
-#include "llvm/ADT/ArrayRef.h"
-
-#include <optional>
-#include <string>
-
-namespace Fortran::semantics {
-class SemanticsContext;
-class Symbol;
-
-// Add this namespace to avoid potential conflicts
-namespace omp {
-// There is no consistent way to get the source of an ActionStmt, but there
-// is "source" in Statement<T>. This structure keeps the ActionStmt with the
-// extracted source for further use.
-struct SourcedActionStmt {
- const parser::ActionStmt *stmt{nullptr};
- parser::CharBlock source;
-
- operator bool() const { return stmt != nullptr; }
-};
-
-SourcedActionStmt GetActionStmt(const parser::ExecutionPartConstruct *x);
-SourcedActionStmt GetActionStmt(const parser::Block &block);
-
-std::string ThisVersion(unsigned version);
-std::string TryVersion(unsigned version);
-
-const parser::Designator *GetDesignatorFromObj(const parser::OmpObject &object);
-const parser::DataRef *GetDataRefFromObj(const parser::OmpObject &object);
-const parser::ArrayElement *GetArrayElementFromObj(
- const parser::OmpObject &object);
-const Symbol *GetObjectSymbol(const parser::OmpObject &object);
-const Symbol *GetArgumentSymbol(const parser::OmpArgument &argument);
-std::optional<parser::CharBlock> GetObjectSource(
- const parser::OmpObject &object);
-
-bool IsCommonBlock(const Symbol &sym);
-bool IsExtendedListItem(const Symbol &sym);
-bool IsVariableListItem(const Symbol &sym);
-bool IsVarOrFunctionRef(const MaybeExpr &expr);
-
-bool IsMapEnteringType(parser::OmpMapType::Value type);
-bool IsMapExitingType(parser::OmpMapType::Value type);
-
-std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr);
-std::optional<evaluate::DynamicType> GetDynamicType(
- const parser::Expr &parserExpr);
-
-std::optional<bool> IsContiguous(
- SemanticsContext &semaCtx, const parser::OmpObject &object);
-
-std::vector<SomeExpr> GetAllDesignators(const SomeExpr &expr);
-const SomeExpr *HasStorageOverlap(
- const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs);
-bool IsAssignment(const parser::ActionStmt *x);
-bool IsPointerAssignment(const evaluate::Assignment &x);
-const parser::Block &GetInnermostExecPart(const parser::Block &block);
-} // namespace omp
-} // namespace Fortran::semantics
-
-#endif // FORTRAN_SEMANTICS_OPENMP_UTILS_H
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 0557b08..fe0d2a7 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -10,7 +10,6 @@
#include "check-acc-structure.h"
#include "check-omp-structure.h"
-#include "openmp-utils.h"
#include "resolve-names-utils.h"
#include "flang/Common/idioms.h"
#include "flang/Evaluate/fold.h"
@@ -22,6 +21,7 @@
#include "flang/Semantics/expression.h"
#include "flang/Semantics/openmp-dsa.h"
#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
#include "flang/Support/Flags.h"
@@ -876,6 +876,9 @@ private:
bool IsNestedInDirective(llvm::omp::Directive directive);
void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
+ void ResolveOmpDesignator(
+ const parser::Designator &designator, Symbol::Flag ompFlag);
+ void ResolveOmpCommonBlock(const parser::Name &name, Symbol::Flag ompFlag);
void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
@@ -2139,8 +2142,8 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionConstruct &x) {
}
bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) {
- const auto &beginCriticalDir{std::get<parser::OmpCriticalDirective>(x.t)};
- PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical);
+ const parser::OmpBeginDirective &beginSpec{x.BeginDir()};
+ PushContext(beginSpec.DirName().source, beginSpec.DirName().v);
GetContext().withinConstruct = true;
return true;
}
@@ -2786,196 +2789,182 @@ static bool SymbolOrEquivalentIsInNamelist(const Symbol &symbol) {
});
}
-void OmpAttributeVisitor::ResolveOmpObject(
- const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
+void OmpAttributeVisitor::ResolveOmpDesignator(
+ const parser::Designator &designator, Symbol::Flag ompFlag) {
unsigned version{context_.langOptions().OpenMPVersion};
- common::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *name{
- semantics::getDesignatorNameIfDataRef(designator)}) {
- if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
- auto checkExclusivelists =
- [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag,
- const Symbol *symbol2, Symbol::Flag secondOmpFlag) {
- if ((symbol1->test(firstOmpFlag) &&
- symbol2->test(secondOmpFlag)) ||
- (symbol1->test(secondOmpFlag) &&
- symbol2->test(firstOmpFlag))) {
- context_.Say(designator.source,
- "Variable '%s' may not "
- "appear on both %s and %s "
- "clauses on a %s construct"_err_en_US,
- symbol2->name(),
- Symbol::OmpFlagToClauseName(firstOmpFlag),
- Symbol::OmpFlagToClauseName(secondOmpFlag),
- parser::ToUpperCaseLetters(
- llvm::omp::getOpenMPDirectiveName(
- GetContext().directive, version)
- .str()));
- }
- };
- if (dataCopyingAttributeFlags.test(ompFlag)) {
- CheckDataCopyingClause(*name, *symbol, ompFlag);
- } else {
- AddToContextObjectWithExplicitDSA(*symbol, ompFlag);
- if (dataSharingAttributeFlags.test(ompFlag)) {
- CheckMultipleAppearances(*name, *symbol, ompFlag);
- }
- if (privateDataSharingAttributeFlags.test(ompFlag)) {
- CheckObjectIsPrivatizable(*name, *symbol, ompFlag);
- }
+ llvm::omp::Directive directive{GetContext().directive};
- if (ompFlag == Symbol::Flag::OmpAllocate) {
- AddAllocateName(name);
- }
- }
- if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
- IsAllocatable(*symbol) &&
- !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) {
- context_.Say(designator.source,
- "List items specified in the ALLOCATE directive must not "
- "have the ALLOCATABLE attribute unless the directive is "
- "associated with an ALLOCATE statement"_err_en_US);
- }
- if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
- ompFlag ==
- Symbol::Flag::OmpExecutableAllocateDirective) &&
- ResolveOmpObjectScope(name) == nullptr) {
- context_.Say(designator.source, // 2.15.3
- "List items must be declared in the same scoping unit "
- "in which the %s directive appears"_err_en_US,
- parser::ToUpperCaseLetters(
- llvm::omp::getOpenMPDirectiveName(
- GetContext().directive, version)
- .str()));
- }
- if (ompFlag == Symbol::Flag::OmpReduction) {
- // Using variables inside of a namelist in OpenMP reductions
- // is allowed by the standard, but is not allowed for
- // privatisation. This looks like an oversight. If the
- // namelist is hoisted to a global, we cannot apply the
- // mapping for the reduction variable: resulting in incorrect
- // results. Disabling this hoisting could make some real
- // production code go slower. See discussion in #109303
- if (SymbolOrEquivalentIsInNamelist(*symbol)) {
- context_.Say(name->source,
- "Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US,
- name->ToString());
- }
- }
- if (ompFlag == Symbol::Flag::OmpInclusiveScan ||
- ompFlag == Symbol::Flag::OmpExclusiveScan) {
- if (!symbol->test(Symbol::Flag::OmpInScanReduction)) {
- context_.Say(name->source,
- "List item %s must appear in REDUCTION clause "
- "with the INSCAN modifier of the parent "
- "directive"_err_en_US,
- name->ToString());
- }
- }
- if (ompFlag == Symbol::Flag::OmpDeclareTarget) {
- if (symbol->IsFuncResult()) {
- if (Symbol * func{currScope().symbol()}) {
- CHECK(func->IsSubprogram());
- func->set(ompFlag);
- name->symbol = func;
- }
- }
- }
- if (GetContext().directive ==
- llvm::omp::Directive::OMPD_target_data) {
- checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr,
- symbol, Symbol::Flag::OmpUseDeviceAddr);
- }
- if (llvm::omp::allDistributeSet.test(GetContext().directive)) {
- checkExclusivelists(symbol, Symbol::Flag::OmpFirstPrivate,
- symbol, Symbol::Flag::OmpLastPrivate);
- }
- if (llvm::omp::allTargetSet.test(GetContext().directive)) {
- checkExclusivelists(symbol, Symbol::Flag::OmpIsDevicePtr,
- symbol, Symbol::Flag::OmpHasDeviceAddr);
- const auto *hostAssocSym{symbol};
- if (!(symbol->test(Symbol::Flag::OmpIsDevicePtr) ||
- symbol->test(Symbol::Flag::OmpHasDeviceAddr))) {
- if (const auto *details{
- symbol->detailsIf<HostAssocDetails>()}) {
- hostAssocSym = &details->symbol();
- }
- }
- Symbol::Flag dataMappingAttributeFlags[] = {
- Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,
- Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapStorage,
- Symbol::Flag::OmpMapDelete, Symbol::Flag::OmpIsDevicePtr,
- Symbol::Flag::OmpHasDeviceAddr};
-
- Symbol::Flag dataSharingAttributeFlags[] = {
- Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
- Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,
- Symbol::Flag::OmpLinear};
-
- // For OMP TARGET TEAMS directive some sharing attribute
- // flags and mapping attribute flags can co-exist.
- if (!(llvm::omp::allTeamsSet.test(GetContext().directive) ||
- llvm::omp::allParallelSet.test(
- GetContext().directive))) {
- for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) {
- for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) {
- if ((hostAssocSym->test(ompFlag2) &&
- hostAssocSym->test(
- Symbol::Flag::OmpExplicit)) ||
- (symbol->test(ompFlag2) &&
- symbol->test(Symbol::Flag::OmpExplicit))) {
- checkExclusivelists(
- hostAssocSym, ompFlag1, symbol, ompFlag2);
- }
- }
- }
- }
- }
- }
- } else {
- // Array sections to be changed to substrings as needed
- if (AnalyzeExpr(context_, designator)) {
- if (std::holds_alternative<parser::Substring>(designator.u)) {
- context_.Say(designator.source,
- "Substrings are not allowed on OpenMP "
- "directives or clauses"_err_en_US);
- }
- }
- // other checks, more TBD
- }
- },
- [&](const parser::Name &name) { // common block
- if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
- if (!dataCopyingAttributeFlags.test(ompFlag)) {
- CheckMultipleAppearances(
- name, *symbol, Symbol::Flag::OmpCommonBlock);
- }
- // 2.15.3 When a named common block appears in a list, it has the
- // same meaning as if every explicit member of the common block
- // appeared in the list
- auto &details{symbol->get<CommonBlockDetails>()};
- unsigned index{0};
- for (auto &object : details.objects()) {
- if (auto *resolvedObject{
- ResolveOmp(*object, ompFlag, currScope())}) {
- if (dataCopyingAttributeFlags.test(ompFlag)) {
- CheckDataCopyingClause(name, *resolvedObject, ompFlag);
- } else {
- AddToContextObjectWithExplicitDSA(*resolvedObject, ompFlag);
- }
- details.replace_object(*resolvedObject, index);
- }
- index++;
- }
- } else {
- context_.Say(name.source, // 2.15.3
- "COMMON block must be declared in the same scoping unit "
- "in which the OpenMP directive or clause appears"_err_en_US);
+ const auto *name{semantics::getDesignatorNameIfDataRef(designator)};
+ if (!name) {
+ // Array sections to be changed to substrings as needed
+ if (AnalyzeExpr(context_, designator)) {
+ if (std::holds_alternative<parser::Substring>(designator.u)) {
+ context_.Say(designator.source,
+ "Substrings are not allowed on OpenMP directives or clauses"_err_en_US);
+ }
+ }
+ // other checks, more TBD
+ return;
+ }
+
+ if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
+ auto checkExclusivelists{//
+ [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag,
+ const Symbol *symbol2, Symbol::Flag secondOmpFlag) {
+ if ((symbol1->test(firstOmpFlag) && symbol2->test(secondOmpFlag)) ||
+ (symbol1->test(secondOmpFlag) && symbol2->test(firstOmpFlag))) {
+ context_.Say(designator.source,
+ "Variable '%s' may not appear on both %s and %s clauses on a %s construct"_err_en_US,
+ symbol2->name(), Symbol::OmpFlagToClauseName(firstOmpFlag),
+ Symbol::OmpFlagToClauseName(secondOmpFlag),
+ parser::ToUpperCaseLetters(
+ llvm::omp::getOpenMPDirectiveName(directive, version)));
+ }
+ }};
+ if (dataCopyingAttributeFlags.test(ompFlag)) {
+ CheckDataCopyingClause(*name, *symbol, ompFlag);
+ } else {
+ AddToContextObjectWithExplicitDSA(*symbol, ompFlag);
+ if (dataSharingAttributeFlags.test(ompFlag)) {
+ CheckMultipleAppearances(*name, *symbol, ompFlag);
+ }
+ if (privateDataSharingAttributeFlags.test(ompFlag)) {
+ CheckObjectIsPrivatizable(*name, *symbol, ompFlag);
+ }
+
+ if (ompFlag == Symbol::Flag::OmpAllocate) {
+ AddAllocateName(name);
+ }
+ }
+ if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
+ IsAllocatable(*symbol) &&
+ !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) {
+ context_.Say(designator.source,
+ "List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement"_err_en_US);
+ }
+ if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
+ ompFlag == Symbol::Flag::OmpExecutableAllocateDirective) &&
+ ResolveOmpObjectScope(name) == nullptr) {
+ context_.Say(designator.source, // 2.15.3
+ "List items must be declared in the same scoping unit in which the %s directive appears"_err_en_US,
+ parser::ToUpperCaseLetters(
+ llvm::omp::getOpenMPDirectiveName(directive, version)));
+ }
+ if (ompFlag == Symbol::Flag::OmpReduction) {
+ // Using variables inside of a namelist in OpenMP reductions
+ // is allowed by the standard, but is not allowed for
+ // privatisation. This looks like an oversight. If the
+ // namelist is hoisted to a global, we cannot apply the
+ // mapping for the reduction variable: resulting in incorrect
+ // results. Disabling this hoisting could make some real
+ // production code go slower. See discussion in #109303
+ if (SymbolOrEquivalentIsInNamelist(*symbol)) {
+ context_.Say(name->source,
+ "Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US,
+ name->ToString());
+ }
+ }
+ if (ompFlag == Symbol::Flag::OmpInclusiveScan ||
+ ompFlag == Symbol::Flag::OmpExclusiveScan) {
+ if (!symbol->test(Symbol::Flag::OmpInScanReduction)) {
+ context_.Say(name->source,
+ "List item %s must appear in REDUCTION clause with the INSCAN modifier of the parent directive"_err_en_US,
+ name->ToString());
+ }
+ }
+ if (ompFlag == Symbol::Flag::OmpDeclareTarget) {
+ if (symbol->IsFuncResult()) {
+ if (Symbol * func{currScope().symbol()}) {
+ CHECK(func->IsSubprogram());
+ func->set(ompFlag);
+ name->symbol = func;
+ }
+ }
+ }
+ if (directive == llvm::omp::Directive::OMPD_target_data) {
+ checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr, symbol,
+ Symbol::Flag::OmpUseDeviceAddr);
+ }
+ if (llvm::omp::allDistributeSet.test(directive)) {
+ checkExclusivelists(symbol, Symbol::Flag::OmpFirstPrivate, symbol,
+ Symbol::Flag::OmpLastPrivate);
+ }
+ if (llvm::omp::allTargetSet.test(directive)) {
+ checkExclusivelists(symbol, Symbol::Flag::OmpIsDevicePtr, symbol,
+ Symbol::Flag::OmpHasDeviceAddr);
+ const auto *hostAssocSym{symbol};
+ if (!symbol->test(Symbol::Flag::OmpIsDevicePtr) &&
+ !symbol->test(Symbol::Flag::OmpHasDeviceAddr)) {
+ if (const auto *details{symbol->detailsIf<HostAssocDetails>()}) {
+ hostAssocSym = &details->symbol();
+ }
+ }
+ static Symbol::Flag dataMappingAttributeFlags[] = {//
+ Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,
+ Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapStorage,
+ Symbol::Flag::OmpMapDelete, Symbol::Flag::OmpIsDevicePtr,
+ Symbol::Flag::OmpHasDeviceAddr};
+
+ static Symbol::Flag dataSharingAttributeFlags[] = {//
+ Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
+ Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,
+ Symbol::Flag::OmpLinear};
+
+ // For OMP TARGET TEAMS directive some sharing attribute
+ // flags and mapping attribute flags can co-exist.
+ if (!llvm::omp::allTeamsSet.test(directive) &&
+ !llvm::omp::allParallelSet.test(directive)) {
+ for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) {
+ for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) {
+ if ((hostAssocSym->test(ompFlag2) &&
+ hostAssocSym->test(Symbol::Flag::OmpExplicit)) ||
+ (symbol->test(ompFlag2) &&
+ symbol->test(Symbol::Flag::OmpExplicit))) {
+ checkExclusivelists(hostAssocSym, ompFlag1, symbol, ompFlag2);
}
- },
- },
+ }
+ }
+ }
+ }
+ }
+}
+
+void OmpAttributeVisitor::ResolveOmpCommonBlock(
+ const parser::Name &name, Symbol::Flag ompFlag) {
+ if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
+ if (!dataCopyingAttributeFlags.test(ompFlag)) {
+ CheckMultipleAppearances(name, *symbol, Symbol::Flag::OmpCommonBlock);
+ }
+ // 2.15.3 When a named common block appears in a list, it has the
+ // same meaning as if every explicit member of the common block
+ // appeared in the list
+ auto &details{symbol->get<CommonBlockDetails>()};
+ for (auto [index, object] : llvm::enumerate(details.objects())) {
+ if (auto *resolvedObject{ResolveOmp(*object, ompFlag, currScope())}) {
+ if (dataCopyingAttributeFlags.test(ompFlag)) {
+ CheckDataCopyingClause(name, *resolvedObject, ompFlag);
+ } else {
+ AddToContextObjectWithExplicitDSA(*resolvedObject, ompFlag);
+ }
+ details.replace_object(*resolvedObject, index);
+ }
+ }
+ } else {
+ context_.Say(name.source, // 2.15.3
+ "COMMON block must be declared in the same scoping unit in which the OpenMP directive or clause appears"_err_en_US);
+ }
+}
+
+void OmpAttributeVisitor::ResolveOmpObject(
+ const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
+ common::visit(common::visitors{
+ [&](const parser::Designator &designator) {
+ ResolveOmpDesignator(designator, ompFlag);
+ },
+ [&](const parser::Name &name) { // common block
+ ResolveOmpCommonBlock(name, ompFlag);
+ },
+ },
ompObject.u);
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 66a45dd..5808b4b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -30,6 +30,7 @@
#include "flang/Semantics/attr.h"
#include "flang/Semantics/expression.h"
#include "flang/Semantics/openmp-modifiers.h"
+#include "flang/Semantics/openmp-utils.h"
#include "flang/Semantics/program-tree.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/semantics.h"
@@ -1486,6 +1487,16 @@ public:
void Post(const parser::OpenMPBlockConstruct &);
bool Pre(const parser::OmpBeginDirective &x) {
AddOmpSourceRange(x.source);
+ // Manually resolve names in CRITICAL directives. This is because these
+ // names do not denote Fortran objects, and the CRITICAL directive causes
+ // them to be "auto-declared", i.e. inserted into the global scope.
+ // More specifically, they are not expected to have explicit declarations,
+ // and if they do the behavior is unspeficied.
+ if (x.DirName().v == llvm::omp::Directive::OMPD_critical) {
+ for (const parser::OmpArgument &arg : x.Arguments().v) {
+ ResolveCriticalName(arg);
+ }
+ }
return true;
}
void Post(const parser::OmpBeginDirective &) {
@@ -1493,6 +1504,12 @@ public:
}
bool Pre(const parser::OmpEndDirective &x) {
AddOmpSourceRange(x.source);
+ // Manually resolve names in CRITICAL directives.
+ if (x.DirName().v == llvm::omp::Directive::OMPD_critical) {
+ for (const parser::OmpArgument &arg : x.Arguments().v) {
+ ResolveCriticalName(arg);
+ }
+ }
return true;
}
void Post(const parser::OmpEndDirective &) {
@@ -1591,32 +1608,6 @@ public:
void Post(const parser::OmpEndSectionsDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
- bool Pre(const parser::OmpCriticalDirective &x) {
- AddOmpSourceRange(x.source);
- // Manually resolve names in CRITICAL directives. This is because these
- // names do not denote Fortran objects, and the CRITICAL directive causes
- // them to be "auto-declared", i.e. inserted into the global scope.
- // More specifically, they are not expected to have explicit declarations,
- // and if they do the behavior is unspeficied.
- if (auto &maybeName{std::get<std::optional<parser::Name>>(x.t)}) {
- ResolveCriticalName(*maybeName);
- }
- return true;
- }
- void Post(const parser::OmpCriticalDirective &) {
- messageHandler().set_currStmtSource(std::nullopt);
- }
- bool Pre(const parser::OmpEndCriticalDirective &x) {
- AddOmpSourceRange(x.source);
- // Manually resolve names in CRITICAL directives.
- if (auto &maybeName{std::get<std::optional<parser::Name>>(x.t)}) {
- ResolveCriticalName(*maybeName);
- }
- return true;
- }
- void Post(const parser::OmpEndCriticalDirective &) {
- messageHandler().set_currStmtSource(std::nullopt);
- }
bool Pre(const parser::OpenMPThreadprivate &) {
SkipImplicitTyping(true);
return true;
@@ -1732,7 +1723,7 @@ private:
const std::optional<parser::OmpClauseList> &clauses,
const T &wholeConstruct);
- void ResolveCriticalName(const parser::Name &name);
+ void ResolveCriticalName(const parser::OmpArgument &arg);
int metaLevel_{0};
const parser::OmpMetadirectiveDirective *metaDirective_{nullptr};
@@ -1961,7 +1952,7 @@ void OmpVisitor::ProcessReductionSpecifier(
}
}
-void OmpVisitor::ResolveCriticalName(const parser::Name &name) {
+void OmpVisitor::ResolveCriticalName(const parser::OmpArgument &arg) {
auto &globalScope{[&]() -> Scope & {
for (Scope *s{&currScope()};; s = &s->parent()) {
if (s->IsTopLevel()) {
@@ -1971,15 +1962,21 @@ void OmpVisitor::ResolveCriticalName(const parser::Name &name) {
llvm_unreachable("Cannot find global scope");
}()};
- if (auto *symbol{FindInScope(globalScope, name)}) {
- if (!symbol->test(Symbol::Flag::OmpCriticalLock)) {
- SayWithDecl(name, *symbol,
- "CRITICAL construct name '%s' conflicts with a previous declaration"_warn_en_US,
- name.ToString());
+ if (auto *object{parser::Unwrap<parser::OmpObject>(arg.u)}) {
+ if (auto *desg{omp::GetDesignatorFromObj(*object)}) {
+ if (auto *name{getDesignatorNameIfDataRef(*desg)}) {
+ if (auto *symbol{FindInScope(globalScope, *name)}) {
+ if (!symbol->test(Symbol::Flag::OmpCriticalLock)) {
+ SayWithDecl(*name, *symbol,
+ "CRITICAL construct name '%s' conflicts with a previous declaration"_warn_en_US,
+ name->ToString());
+ }
+ } else {
+ name->symbol = &MakeSymbol(globalScope, name->source, Attrs{});
+ name->symbol->set(Symbol::Flag::OmpCriticalLock);
+ }
+ }
}
- } else {
- name.symbol = &MakeSymbol(globalScope, name.source, Attrs{});
- name.symbol->set(Symbol::Flag::OmpCriticalLock);
}
}
diff --git a/flang/lib/Semantics/unparse-with-symbols.cpp b/flang/lib/Semantics/unparse-with-symbols.cpp
index 3093e39..41077e0 100644
--- a/flang/lib/Semantics/unparse-with-symbols.cpp
+++ b/flang/lib/Semantics/unparse-with-symbols.cpp
@@ -70,20 +70,6 @@ public:
currStmt_ = std::nullopt;
}
- bool Pre(const parser::OmpCriticalDirective &x) {
- currStmt_ = x.source;
- return true;
- }
- void Post(const parser::OmpCriticalDirective &) { currStmt_ = std::nullopt; }
-
- bool Pre(const parser::OmpEndCriticalDirective &x) {
- currStmt_ = x.source;
- return true;
- }
- void Post(const parser::OmpEndCriticalDirective &) {
- currStmt_ = std::nullopt;
- }
-
// Directive arguments can be objects with symbols.
bool Pre(const parser::OmpBeginDirective &x) {
currStmt_ = x.source;
generated by cgit v1.1 at 2025-08-08 06:37:12 +0000