aboutsummaryrefslogtreecommitdiff
path: root/flang/lib/Semantics
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Semantics')
-rw-r--r--flang/lib/Semantics/check-declarations.cpp2
-rw-r--r--flang/lib/Semantics/check-omp-atomic.cpp39
-rw-r--r--flang/lib/Semantics/check-omp-structure.cpp56
-rw-r--r--flang/lib/Semantics/check-omp-structure.h8
-rw-r--r--flang/lib/Semantics/mod-file.cpp37
-rw-r--r--flang/lib/Semantics/openmp-modifiers.cpp16
-rw-r--r--flang/lib/Semantics/openmp-utils.cpp23
-rw-r--r--flang/lib/Semantics/resolve-directives.cpp207
-rw-r--r--flang/lib/Semantics/resolve-directives.h2
-rw-r--r--flang/lib/Semantics/resolve-names.cpp3
-rw-r--r--flang/lib/Semantics/symbol.cpp32
11 files changed, 260 insertions, 165 deletions
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index ea5e2c0..31e246c 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3622,6 +3622,7 @@ void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp,
ioKind == common::DefinedIo::ReadUnformatted
? Attr::INTENT_INOUT
: Attr::INTENT_IN);
+ CheckDioDummyIsScalar(subp, *arg);
}
}
@@ -3687,6 +3688,7 @@ void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp,
"Dummy argument '%s' of a defined input/output procedure must be assumed-length CHARACTER of default kind"_err_en_US,
arg->name());
}
+ CheckDioDummyIsScalar(subp, *arg);
}
}
diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
index 351af5c..515121a 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -519,8 +519,8 @@ private:
/// function references with scalar data pointer result of non-character
/// intrinsic type or variables that are non-polymorphic scalar pointers
/// and any length type parameter must be constant.
-void OmpStructureChecker::CheckAtomicType(
- SymbolRef sym, parser::CharBlock source, std::string_view name) {
+void OmpStructureChecker::CheckAtomicType(SymbolRef sym,
+ parser::CharBlock source, std::string_view name, bool checkTypeOnPointer) {
const DeclTypeSpec *typeSpec{sym->GetType()};
if (!typeSpec) {
return;
@@ -547,6 +547,22 @@ void OmpStructureChecker::CheckAtomicType(
return;
}
+ // Apply pointer-to-non-intrinsic rule only for intrinsic-assignment paths.
+ if (checkTypeOnPointer) {
+ using Category = DeclTypeSpec::Category;
+ Category cat{typeSpec->category()};
+ if (cat != Category::Numeric && cat != Category::Logical) {
+ std::string details = " has the POINTER attribute";
+ if (const auto *derived{typeSpec->AsDerived()}) {
+ details += " and derived type '"s + derived->name().ToString() + "'";
+ }
+ context_.Say(source,
+ "ATOMIC operation requires an intrinsic scalar variable; '%s'%s"_err_en_US,
+ sym->name(), details);
+ return;
+ }
+ }
+
// Go over all length parameters, if any, and check if they are
// explicit.
if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
@@ -562,7 +578,7 @@ void OmpStructureChecker::CheckAtomicType(
}
void OmpStructureChecker::CheckAtomicVariable(
- const SomeExpr &atom, parser::CharBlock source) {
+ const SomeExpr &atom, parser::CharBlock source, bool checkTypeOnPointer) {
if (atom.Rank() != 0) {
context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
atom.AsFortran());
@@ -572,7 +588,7 @@ void OmpStructureChecker::CheckAtomicVariable(
assert(dsgs.size() == 1 && "Should have a single top-level designator");
evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
- CheckAtomicType(syms.back(), source, atom.AsFortran());
+ CheckAtomicType(syms.back(), source, atom.AsFortran(), checkTypeOnPointer);
if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
@@ -789,7 +805,8 @@ void OmpStructureChecker::CheckAtomicCaptureAssignment(
if (!IsVarOrFunctionRef(atom)) {
ErrorShouldBeVariable(atom, rsrc);
} else {
- CheckAtomicVariable(atom, rsrc);
+ CheckAtomicVariable(
+ atom, rsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(capture));
// This part should have been checked prior to calling this function.
assert(*GetConvertInput(capture.rhs) == atom &&
"This cannot be a capture assignment");
@@ -808,7 +825,8 @@ void OmpStructureChecker::CheckAtomicReadAssignment(
if (!IsVarOrFunctionRef(atom)) {
ErrorShouldBeVariable(atom, rsrc);
} else {
- CheckAtomicVariable(atom, rsrc);
+ CheckAtomicVariable(
+ atom, rsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(read));
CheckStorageOverlap(atom, {read.lhs}, source);
}
} else {
@@ -829,7 +847,8 @@ void OmpStructureChecker::CheckAtomicWriteAssignment(
if (!IsVarOrFunctionRef(atom)) {
ErrorShouldBeVariable(atom, rsrc);
} else {
- CheckAtomicVariable(atom, lsrc);
+ CheckAtomicVariable(
+ atom, lsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(write));
CheckStorageOverlap(atom, {write.rhs}, source);
}
}
@@ -854,7 +873,8 @@ OmpStructureChecker::CheckAtomicUpdateAssignment(
return std::nullopt;
}
- CheckAtomicVariable(atom, lsrc);
+ CheckAtomicVariable(
+ atom, lsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(update));
auto [hasErrors, tryReassoc]{CheckAtomicUpdateAssignmentRhs(
atom, update.rhs, source, /*suppressDiagnostics=*/true)};
@@ -1017,7 +1037,8 @@ void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
return;
}
- CheckAtomicVariable(atom, alsrc);
+ CheckAtomicVariable(
+ atom, alsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(assign));
auto top{GetTopLevelOperationIgnoreResizing(cond)};
// Missing arguments to operations would have been diagnosed by now.
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index d65a89e..4b5610a 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -3017,8 +3017,8 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
&objs,
std::string clause) {
for (const auto &obj : objs.v) {
- if (const parser::Name *
- objName{parser::Unwrap<parser::Name>(obj)}) {
+ if (const parser::Name *objName{
+ parser::Unwrap<parser::Name>(obj)}) {
if (&objName->symbol->GetUltimate() == eventHandleSym) {
context_.Say(GetContext().clauseSource,
"A variable: `%s` that appears in a DETACH clause cannot appear on %s clause on the same construct"_err_en_US,
@@ -3637,7 +3637,8 @@ void OmpStructureChecker::CheckReductionModifier(
if (modifier.v == ReductionModifier::Value::Task) {
// "Task" is only allowed on worksharing or "parallel" directive.
static llvm::omp::Directive worksharing[]{
- llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_scope,
+ llvm::omp::Directive::OMPD_do, //
+ llvm::omp::Directive::OMPD_scope, //
llvm::omp::Directive::OMPD_sections,
// There are more worksharing directives, but they do not apply:
// "for" is C++ only,
@@ -4081,9 +4082,15 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
CheckIteratorModifier(*iter);
}
+
+ using Directive = llvm::omp::Directive;
+ Directive dir{GetContext().directive};
+ llvm::ArrayRef<Directive> leafs{llvm::omp::getLeafConstructsOrSelf(dir)};
+ parser::OmpMapType::Value mapType{parser::OmpMapType::Value::Storage};
+
if (auto *type{OmpGetUniqueModifier<parser::OmpMapType>(modifiers)}) {
- using Directive = llvm::omp::Directive;
using Value = parser::OmpMapType::Value;
+ mapType = type->v;
static auto isValidForVersion{
[](parser::OmpMapType::Value t, unsigned version) {
@@ -4120,10 +4127,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
return result;
}()};
- llvm::omp::Directive dir{GetContext().directive};
- llvm::ArrayRef<llvm::omp::Directive> leafs{
- llvm::omp::getLeafConstructsOrSelf(dir)};
-
if (llvm::is_contained(leafs, Directive::OMPD_target) ||
llvm::is_contained(leafs, Directive::OMPD_target_data)) {
if (version >= 60) {
@@ -4141,6 +4144,43 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
}
}
+ if (auto *attach{
+ OmpGetUniqueModifier<parser::OmpAttachModifier>(modifiers)}) {
+ bool mapEnteringConstructOrMapper{
+ llvm::is_contained(leafs, Directive::OMPD_target) ||
+ llvm::is_contained(leafs, Directive::OMPD_target_data) ||
+ llvm::is_contained(leafs, Directive::OMPD_target_enter_data) ||
+ llvm::is_contained(leafs, Directive::OMPD_declare_mapper)};
+
+ if (!mapEnteringConstructOrMapper || !IsMapEnteringType(mapType)) {
+ const auto &desc{OmpGetDescriptor<parser::OmpAttachModifier>()};
+ context_.Say(OmpGetModifierSource(modifiers, attach),
+ "The '%s' modifier can only appear on a map-entering construct or on a DECLARE_MAPPER directive"_err_en_US,
+ desc.name.str());
+ }
+
+ auto hasBasePointer{[&](const SomeExpr &item) {
+ evaluate::SymbolVector symbols{evaluate::GetSymbolVector(item)};
+ return llvm::any_of(
+ symbols, [](SymbolRef s) { return IsPointer(s.get()); });
+ }};
+
+ evaluate::ExpressionAnalyzer ea{context_};
+ const auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
+ for (auto &object : objects.v) {
+ if (const parser::Designator *d{GetDesignatorFromObj(object)}) {
+ if (auto &&expr{ea.Analyze(*d)}) {
+ if (hasBasePointer(*expr)) {
+ continue;
+ }
+ }
+ }
+ auto source{GetObjectSource(object)};
+ context_.Say(source ? *source : GetContext().clauseSource,
+ "A list-item that appears in a map clause with the ATTACH modifier must have a base-pointer"_err_en_US);
+ }
+ }
+
auto &&typeMods{
OmpGetRepeatableModifier<parser::OmpMapTypeModifier>(modifiers)};
struct Less {
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index f507278..543642ff 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -262,10 +262,10 @@ private:
void CheckStorageOverlap(const evaluate::Expr<evaluate::SomeType> &,
llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>>, parser::CharBlock);
void ErrorShouldBeVariable(const MaybeExpr &expr, parser::CharBlock source);
- void CheckAtomicType(
- SymbolRef sym, parser::CharBlock source, std::string_view name);
- void CheckAtomicVariable(
- const evaluate::Expr<evaluate::SomeType> &, parser::CharBlock);
+ void CheckAtomicType(SymbolRef sym, parser::CharBlock source,
+ std::string_view name, bool checkTypeOnPointer = true);
+ void CheckAtomicVariable(const evaluate::Expr<evaluate::SomeType> &,
+ parser::CharBlock, bool checkTypeOnPointer = true);
std::pair<const parser::ExecutionPartConstruct *,
const parser::ExecutionPartConstruct *>
CheckUpdateCapture(const parser::ExecutionPartConstruct *ec1,
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 8074c94..556259d 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -17,6 +17,7 @@
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
+#include "llvm/Frontend/OpenMP/OMP.h"
#include "llvm/Support/FileSystem.h"
#include "llvm/Support/MemoryBuffer.h"
#include "llvm/Support/raw_ostream.h"
@@ -24,6 +25,7 @@
#include <fstream>
#include <set>
#include <string_view>
+#include <type_traits>
#include <variant>
#include <vector>
@@ -359,6 +361,40 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) {
}
}
+static void PutOpenMPRequirements(llvm::raw_ostream &os, const Symbol &symbol) {
+ using RequiresClauses = WithOmpDeclarative::RequiresClauses;
+ using OmpMemoryOrderType = common::OmpMemoryOrderType;
+
+ const auto [reqs, order]{common::visit(
+ [&](auto &&details)
+ -> std::pair<const RequiresClauses *, const OmpMemoryOrderType *> {
+ if constexpr (std::is_convertible_v<decltype(details),
+ const WithOmpDeclarative &>) {
+ return {details.ompRequires(), details.ompAtomicDefaultMemOrder()};
+ } else {
+ return {nullptr, nullptr};
+ }
+ },
+ symbol.details())};
+
+ if (order) {
+ llvm::omp::Clause admo{llvm::omp::Clause::OMPC_atomic_default_mem_order};
+ os << "!$omp requires "
+ << parser::ToLowerCaseLetters(llvm::omp::getOpenMPClauseName(admo))
+ << '(' << parser::ToLowerCaseLetters(EnumToString(*order)) << ")\n";
+ }
+ if (reqs) {
+ os << "!$omp requires";
+ reqs->IterateOverMembers([&](llvm::omp::Clause f) {
+ if (f != llvm::omp::Clause::OMPC_atomic_default_mem_order) {
+ os << ' '
+ << parser::ToLowerCaseLetters(llvm::omp::getOpenMPClauseName(f));
+ }
+ });
+ os << "\n";
+ }
+}
+
// Put out the visible symbols from scope.
void ModFileWriter::PutSymbols(
const Scope &scope, UnorderedSymbolSet *hermeticModules) {
@@ -396,6 +432,7 @@ void ModFileWriter::PutSymbols(
for (const Symbol &symbol : uses) {
PutUse(symbol);
}
+ PutOpenMPRequirements(decls_, DEREF(scope.symbol()));
for (const auto &set : scope.equivalenceSets()) {
if (!set.empty() &&
!set.front().symbol.test(Symbol::Flag::CompilerCreated)) {
diff --git a/flang/lib/Semantics/openmp-modifiers.cpp b/flang/lib/Semantics/openmp-modifiers.cpp
index af4000c..717fb03 100644
--- a/flang/lib/Semantics/openmp-modifiers.cpp
+++ b/flang/lib/Semantics/openmp-modifiers.cpp
@@ -157,6 +157,22 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpAlwaysModifier>() {
}
template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpAttachModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"attach-modifier",
+ /*props=*/
+ {
+ {61, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {61, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpAutomapModifier>() {
static const OmpModifierDescriptor desc{
/*name=*/"automap-modifier",
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index a8ec4d6..292e73b 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -13,6 +13,7 @@
#include "flang/Semantics/openmp-utils.h"
#include "flang/Common/Fortran-consts.h"
+#include "flang/Common/idioms.h"
#include "flang/Common/indirection.h"
#include "flang/Common/reference.h"
#include "flang/Common/visit.h"
@@ -59,6 +60,26 @@ const Scope &GetScopingUnit(const Scope &scope) {
return *iter;
}
+const Scope &GetProgramUnit(const Scope &scope) {
+ const Scope *unit{nullptr};
+ for (const Scope *iter{&scope}; !iter->IsTopLevel(); iter = &iter->parent()) {
+ switch (iter->kind()) {
+ case Scope::Kind::BlockData:
+ case Scope::Kind::MainProgram:
+ case Scope::Kind::Module:
+ return *iter;
+ case Scope::Kind::Subprogram:
+ // Ignore subprograms that are nested.
+ unit = iter;
+ break;
+ default:
+ break;
+ }
+ }
+ assert(unit && "Scope not in a program unit");
+ return *unit;
+}
+
SourcedActionStmt GetActionStmt(const parser::ExecutionPartConstruct *x) {
if (x == nullptr) {
return SourcedActionStmt{};
@@ -202,7 +223,7 @@ std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
// ForwardOwningPointer typedExpr
// `- GenericExprWrapper ^.get()
// `- std::optional<Expr> ^->v
- return typedExpr.get()->v;
+ return DEREF(typedExpr.get()).v;
}
std::optional<evaluate::DynamicType> GetDynamicType(
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 18fc638..1228493 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -435,6 +435,22 @@ public:
return true;
}
+ bool Pre(const parser::UseStmt &x) {
+ if (x.moduleName.symbol) {
+ Scope &thisScope{context_.FindScope(x.moduleName.source)};
+ common::visit(
+ [&](auto &&details) {
+ if constexpr (std::is_convertible_v<decltype(details),
+ const WithOmpDeclarative &>) {
+ AddOmpRequiresToScope(thisScope, details.ompRequires(),
+ details.ompAtomicDefaultMemOrder());
+ }
+ },
+ x.moduleName.symbol->details());
+ }
+ return true;
+ }
+
bool Pre(const parser::OmpMetadirectiveDirective &x) {
PushContext(x.v.source, llvm::omp::Directive::OMPD_metadirective);
return true;
@@ -538,38 +554,37 @@ public:
void Post(const parser::OpenMPFlushConstruct &) { PopContext(); }
bool Pre(const parser::OpenMPRequiresConstruct &x) {
- using Flags = WithOmpDeclarative::RequiresFlags;
- using Requires = WithOmpDeclarative::RequiresFlag;
+ using RequiresClauses = WithOmpDeclarative::RequiresClauses;
PushContext(x.source, llvm::omp::Directive::OMPD_requires);
// Gather information from the clauses.
- Flags flags;
- std::optional<common::OmpMemoryOrderType> memOrder;
+ RequiresClauses reqs;
+ const common::OmpMemoryOrderType *memOrder{nullptr};
for (const parser::OmpClause &clause : x.v.Clauses().v) {
- flags |= common::visit(
+ using OmpClause = parser::OmpClause;
+ reqs |= common::visit(
common::visitors{
- [&memOrder](
- const parser::OmpClause::AtomicDefaultMemOrder &atomic) {
- memOrder = atomic.v.v;
- return Flags{};
- },
- [](const parser::OmpClause::ReverseOffload &) {
- return Flags{Requires::ReverseOffload};
- },
- [](const parser::OmpClause::UnifiedAddress &) {
- return Flags{Requires::UnifiedAddress};
+ [&](const OmpClause::AtomicDefaultMemOrder &atomic) {
+ memOrder = &atomic.v.v;
+ return RequiresClauses{};
},
- [](const parser::OmpClause::UnifiedSharedMemory &) {
- return Flags{Requires::UnifiedSharedMemory};
- },
- [](const parser::OmpClause::DynamicAllocators &) {
- return Flags{Requires::DynamicAllocators};
+ [&](auto &&s) {
+ using TypeS = llvm::remove_cvref_t<decltype(s)>;
+ if constexpr ( //
+ std::is_same_v<TypeS, OmpClause::DynamicAllocators> ||
+ std::is_same_v<TypeS, OmpClause::ReverseOffload> ||
+ std::is_same_v<TypeS, OmpClause::UnifiedAddress> ||
+ std::is_same_v<TypeS, OmpClause::UnifiedSharedMemory>) {
+ return RequiresClauses{clause.Id()};
+ } else {
+ return RequiresClauses{};
+ }
},
- [](const auto &) { return Flags{}; }},
+ },
clause.u);
}
// Merge clauses into parents' symbols details.
- AddOmpRequiresToScope(currScope(), flags, memOrder);
+ AddOmpRequiresToScope(currScope(), &reqs, memOrder);
return true;
}
void Post(const parser::OpenMPRequiresConstruct &) { PopContext(); }
@@ -1001,8 +1016,9 @@ private:
std::int64_t ordCollapseLevel{0};
- void AddOmpRequiresToScope(Scope &, WithOmpDeclarative::RequiresFlags,
- std::optional<common::OmpMemoryOrderType>);
+ void AddOmpRequiresToScope(Scope &,
+ const WithOmpDeclarative::RequiresClauses *,
+ const common::OmpMemoryOrderType *);
void IssueNonConformanceWarning(llvm::omp::Directive D,
parser::CharBlock source, unsigned EmitFromVersion);
@@ -3309,86 +3325,6 @@ void ResolveOmpParts(
}
}
-void ResolveOmpTopLevelParts(
- SemanticsContext &context, const parser::Program &program) {
- if (!context.IsEnabled(common::LanguageFeature::OpenMP)) {
- return;
- }
-
- // Gather REQUIRES clauses from all non-module top-level program unit symbols,
- // combine them together ensuring compatibility and apply them to all these
- // program units. Modules are skipped because their REQUIRES clauses should be
- // propagated via USE statements instead.
- WithOmpDeclarative::RequiresFlags combinedFlags;
- std::optional<common::OmpMemoryOrderType> combinedMemOrder;
-
- // Function to go through non-module top level program units and extract
- // REQUIRES information to be processed by a function-like argument.
- auto processProgramUnits{[&](auto processFn) {
- for (const parser::ProgramUnit &unit : program.v) {
- if (!std::holds_alternative<common::Indirection<parser::Module>>(
- unit.u) &&
- !std::holds_alternative<common::Indirection<parser::Submodule>>(
- unit.u) &&
- !std::holds_alternative<
- common::Indirection<parser::CompilerDirective>>(unit.u)) {
- Symbol *symbol{common::visit(
- [&context](auto &x) {
- Scope *scope = GetScope(context, x.value());
- return scope ? scope->symbol() : nullptr;
- },
- unit.u)};
- // FIXME There is no symbol defined for MainProgram units in certain
- // circumstances, so REQUIRES information has no place to be stored in
- // these cases.
- if (!symbol) {
- continue;
- }
- common::visit(
- [&](auto &details) {
- if constexpr (std::is_convertible_v<decltype(&details),
- WithOmpDeclarative *>) {
- processFn(*symbol, details);
- }
- },
- symbol->details());
- }
- }
- }};
-
- // Combine global REQUIRES information from all program units except modules
- // and submodules.
- processProgramUnits([&](Symbol &symbol, WithOmpDeclarative &details) {
- if (const WithOmpDeclarative::RequiresFlags *
- flags{details.ompRequires()}) {
- combinedFlags |= *flags;
- }
- if (const common::OmpMemoryOrderType *
- memOrder{details.ompAtomicDefaultMemOrder()}) {
- if (combinedMemOrder && *combinedMemOrder != *memOrder) {
- context.Say(symbol.scope()->sourceRange(),
- "Conflicting '%s' REQUIRES clauses found in compilation "
- "unit"_err_en_US,
- parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
- llvm::omp::Clause::OMPC_atomic_default_mem_order)
- .str()));
- }
- combinedMemOrder = *memOrder;
- }
- });
-
- // Update all program units except modules and submodules with the combined
- // global REQUIRES information.
- processProgramUnits([&](Symbol &, WithOmpDeclarative &details) {
- if (combinedFlags.any()) {
- details.set_ompRequires(combinedFlags);
- }
- if (combinedMemOrder) {
- details.set_ompAtomicDefaultMemOrder(*combinedMemOrder);
- }
- });
-}
-
static bool IsSymbolThreadprivate(const Symbol &symbol) {
if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
return details->symbol().test(Symbol::Flag::OmpThreadprivate);
@@ -3547,42 +3483,39 @@ void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source,
}
void OmpAttributeVisitor::AddOmpRequiresToScope(Scope &scope,
- WithOmpDeclarative::RequiresFlags flags,
- std::optional<common::OmpMemoryOrderType> memOrder) {
- Scope *scopeIter = &scope;
- do {
- if (Symbol * symbol{scopeIter->symbol()}) {
- common::visit(
- [&](auto &details) {
- // Store clauses information into the symbol for the parent and
- // enclosing modules, programs, functions and subroutines.
- if constexpr (std::is_convertible_v<decltype(&details),
- WithOmpDeclarative *>) {
- if (flags.any()) {
- if (const WithOmpDeclarative::RequiresFlags *
- otherFlags{details.ompRequires()}) {
- flags |= *otherFlags;
- }
- details.set_ompRequires(flags);
+ const WithOmpDeclarative::RequiresClauses *reqs,
+ const common::OmpMemoryOrderType *memOrder) {
+ const Scope &programUnit{omp::GetProgramUnit(scope)};
+ using RequiresClauses = WithOmpDeclarative::RequiresClauses;
+ RequiresClauses combinedReqs{reqs ? *reqs : RequiresClauses{}};
+
+ if (auto *symbol{const_cast<Symbol *>(programUnit.symbol())}) {
+ common::visit(
+ [&](auto &details) {
+ if constexpr (std::is_convertible_v<decltype(&details),
+ WithOmpDeclarative *>) {
+ if (combinedReqs.any()) {
+ if (const RequiresClauses *otherReqs{details.ompRequires()}) {
+ combinedReqs |= *otherReqs;
}
- if (memOrder) {
- if (details.has_ompAtomicDefaultMemOrder() &&
- *details.ompAtomicDefaultMemOrder() != *memOrder) {
- context_.Say(scopeIter->sourceRange(),
- "Conflicting '%s' REQUIRES clauses found in compilation "
- "unit"_err_en_US,
- parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
- llvm::omp::Clause::OMPC_atomic_default_mem_order)
- .str()));
- }
- details.set_ompAtomicDefaultMemOrder(*memOrder);
+ details.set_ompRequires(combinedReqs);
+ }
+ if (memOrder) {
+ if (details.has_ompAtomicDefaultMemOrder() &&
+ *details.ompAtomicDefaultMemOrder() != *memOrder) {
+ context_.Say(programUnit.sourceRange(),
+ "Conflicting '%s' REQUIRES clauses found in compilation "
+ "unit"_err_en_US,
+ parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
+ llvm::omp::Clause::OMPC_atomic_default_mem_order)
+ .str()));
}
+ details.set_ompAtomicDefaultMemOrder(*memOrder);
}
- },
- symbol->details());
- }
- scopeIter = &scopeIter->parent();
- } while (!scopeIter->IsGlobal());
+ }
+ },
+ symbol->details());
+ }
}
void OmpAttributeVisitor::IssueNonConformanceWarning(llvm::omp::Directive D,
diff --git a/flang/lib/Semantics/resolve-directives.h b/flang/lib/Semantics/resolve-directives.h
index 5a890c2..36d3ce9 100644
--- a/flang/lib/Semantics/resolve-directives.h
+++ b/flang/lib/Semantics/resolve-directives.h
@@ -23,7 +23,5 @@ class SemanticsContext;
void ResolveAccParts(
SemanticsContext &, const parser::ProgramUnit &, Scope *topScope);
void ResolveOmpParts(SemanticsContext &, const parser::ProgramUnit &);
-void ResolveOmpTopLevelParts(SemanticsContext &, const parser::Program &);
-
} // namespace Fortran::semantics
#endif
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 86121880..ae0ff9ca 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -10687,9 +10687,6 @@ void ResolveNamesVisitor::Post(const parser::Program &x) {
CHECK(!attrs_);
CHECK(!cudaDataAttr_);
CHECK(!GetDeclTypeSpec());
- // Top-level resolution to propagate information across program units after
- // each of them has been resolved separately.
- ResolveOmpTopLevelParts(context(), x);
}
// A singleton instance of the scope -> IMPLICIT rules mapping is
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 69169469..0ec44b7 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -70,6 +70,32 @@ static void DumpList(llvm::raw_ostream &os, const char *label, const T &list) {
}
}
+llvm::raw_ostream &operator<<(
+ llvm::raw_ostream &os, const WithOmpDeclarative &x) {
+ if (x.has_ompRequires() || x.has_ompAtomicDefaultMemOrder()) {
+ os << " OmpRequirements:(";
+ if (const common::OmpMemoryOrderType *admo{x.ompAtomicDefaultMemOrder()}) {
+ os << parser::ToLowerCaseLetters(llvm::omp::getOpenMPClauseName(
+ llvm::omp::Clause::OMPC_atomic_default_mem_order))
+ << '(' << parser::ToLowerCaseLetters(EnumToString(*admo)) << ')';
+ if (x.has_ompRequires()) {
+ os << ',';
+ }
+ }
+ if (const WithOmpDeclarative::RequiresClauses *reqs{x.ompRequires()}) {
+ size_t num{0}, size{reqs->count()};
+ reqs->IterateOverMembers([&](llvm::omp::Clause f) {
+ os << parser::ToLowerCaseLetters(llvm::omp::getOpenMPClauseName(f));
+ if (++num < size) {
+ os << ',';
+ }
+ });
+ }
+ os << ')';
+ }
+ return os;
+}
+
void SubprogramDetails::set_moduleInterface(Symbol &symbol) {
CHECK(!moduleInterface_);
moduleInterface_ = &symbol;
@@ -150,6 +176,7 @@ llvm::raw_ostream &operator<<(
os << x;
}
}
+ os << static_cast<const WithOmpDeclarative &>(x);
return os;
}
@@ -580,7 +607,9 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) {
common::visit( //
common::visitors{
[&](const UnknownDetails &) {},
- [&](const MainProgramDetails &) {},
+ [&](const MainProgramDetails &x) {
+ os << static_cast<const WithOmpDeclarative &>(x);
+ },
[&](const ModuleDetails &x) {
if (x.isSubmodule()) {
os << " (";
@@ -599,6 +628,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) {
if (x.isDefaultPrivate()) {
os << " isDefaultPrivate";
}
+ os << static_cast<const WithOmpDeclarative &>(x);
},
[&](const SubprogramNameDetails &x) {
os << ' ' << EnumToString(x.kind());
generated by cgit v1.1 at 2025-10-16 16:05:02 +0000