aboutsummaryrefslogtreecommitdiff
path: root/flang/lib/Semantics
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Semantics')
-rw-r--r--flang/lib/Semantics/canonicalize-omp.cpp54
-rw-r--r--flang/lib/Semantics/canonicalize-omp.h9
-rw-r--r--flang/lib/Semantics/check-omp-structure.cpp164
-rw-r--r--flang/lib/Semantics/check-omp-structure.h4
-rw-r--r--flang/lib/Semantics/openmp-modifiers.cpp115
-rw-r--r--flang/lib/Semantics/openmp-utils.cpp25
-rw-r--r--flang/lib/Semantics/openmp-utils.h3
-rw-r--r--flang/lib/Semantics/resolve-directives.cpp52
-rw-r--r--flang/lib/Semantics/semantics.cpp3
-rw-r--r--flang/lib/Semantics/symbol.cpp3
10 files changed, 341 insertions, 91 deletions
diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp
index cf05d84..9722eca 100644
--- a/flang/lib/Semantics/canonicalize-omp.cpp
+++ b/flang/lib/Semantics/canonicalize-omp.cpp
@@ -9,6 +9,7 @@
#include "canonicalize-omp.h"
#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/semantics.h"
// After Loop Canonicalization, rewrite OpenMP parse tree to make OpenMP
// Constructs more structured which provide explicit scopes for later
@@ -27,7 +28,8 @@ class CanonicalizationOfOmp {
public:
template <typename T> bool Pre(T &) { return true; }
template <typename T> void Post(T &) {}
- CanonicalizationOfOmp(parser::Messages &messages) : messages_{messages} {}
+ CanonicalizationOfOmp(SemanticsContext &context)
+ : context_{context}, messages_{context.messages()} {}
void Post(parser::Block &block) {
for (auto it{block.begin()}; it != block.end(); ++it) {
@@ -88,6 +90,8 @@ public:
CanonicalizeUtilityConstructs(spec);
}
+ void Post(parser::OmpMapClause &map) { CanonicalizeMapModifiers(map); }
+
private:
template <typename T> T *GetConstructIf(parser::ExecutionPartConstruct &x) {
if (auto *y{std::get_if<parser::ExecutableConstruct>(&x.u)}) {
@@ -390,16 +394,58 @@ private:
omps.erase(rlast.base(), omps.end());
}
+ // Map clause modifiers are parsed as per OpenMP 6.0 spec. That spec has
+ // changed properties of some of the modifiers, for example it has expanded
+ // map-type-modifier into 3 individual modifiers (one for each of the
+ // possible values of the original modifier), and the "map-type" modifier
+ // is no longer ultimate.
+ // To utilize the modifier validation framework for semantic checks,
+ // if the specified OpenMP version is less than 6.0, rewrite the affected
+ // modifiers back into the pre-6.0 forms.
+ void CanonicalizeMapModifiers(parser::OmpMapClause &map) {
+ unsigned version{context_.langOptions().OpenMPVersion};
+ if (version >= 60) {
+ return;
+ }
+
+ // Omp{Always, Close, Present, xHold}Modifier -> OmpMapTypeModifier
+ // OmpDeleteModifier -> OmpMapType
+ using Modifier = parser::OmpMapClause::Modifier;
+ using Modifiers = std::optional<std::list<Modifier>>;
+ auto &modifiers{std::get<Modifiers>(map.t)};
+ if (!modifiers) {
+ return;
+ }
+
+ using MapTypeModifier = parser::OmpMapTypeModifier;
+ using MapType = parser::OmpMapType;
+
+ for (auto &mod : *modifiers) {
+ if (std::holds_alternative<parser::OmpAlwaysModifier>(mod.u)) {
+ mod.u = MapTypeModifier(MapTypeModifier::Value::Always);
+ } else if (std::holds_alternative<parser::OmpCloseModifier>(mod.u)) {
+ mod.u = MapTypeModifier(MapTypeModifier::Value::Close);
+ } else if (std::holds_alternative<parser::OmpPresentModifier>(mod.u)) {
+ mod.u = MapTypeModifier(MapTypeModifier::Value::Present);
+ } else if (std::holds_alternative<parser::OmpxHoldModifier>(mod.u)) {
+ mod.u = MapTypeModifier(MapTypeModifier::Value::Ompx_Hold);
+ } else if (std::holds_alternative<parser::OmpDeleteModifier>(mod.u)) {
+ mod.u = MapType(MapType::Value::Delete);
+ }
+ }
+ }
+
// Mapping from the specification parts to the blocks that follow in the
// same construct. This is for converting utility constructs to executable
// constructs.
std::map<parser::SpecificationPart *, parser::Block *> blockForSpec_;
+ SemanticsContext &context_;
parser::Messages &messages_;
};
-bool CanonicalizeOmp(parser::Messages &messages, parser::Program &program) {
- CanonicalizationOfOmp omp{messages};
+bool CanonicalizeOmp(SemanticsContext &context, parser::Program &program) {
+ CanonicalizationOfOmp omp{context};
Walk(program, omp);
- return !messages.AnyFatalError();
+ return !context.messages().AnyFatalError();
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/canonicalize-omp.h b/flang/lib/Semantics/canonicalize-omp.h
index c45d6bb..3251218 100644
--- a/flang/lib/Semantics/canonicalize-omp.h
+++ b/flang/lib/Semantics/canonicalize-omp.h
@@ -11,11 +11,12 @@
namespace Fortran::parser {
struct Program;
-class Messages;
-} // namespace Fortran::parser
+}
namespace Fortran::semantics {
-bool CanonicalizeOmp(parser::Messages &messages, parser::Program &program);
-}
+class SemanticsContext;
+
+bool CanonicalizeOmp(SemanticsContext &context, parser::Program &program);
+} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_CANONICALIZE_OMP_H_
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index e4a94ef..d214d22 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -16,7 +16,6 @@
#include "flang/Common/idioms.h"
#include "flang/Common/indirection.h"
#include "flang/Common/visit.h"
-#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/char-block.h"
@@ -37,6 +36,7 @@
#include "llvm/ADT/ArrayRef.h"
#include "llvm/ADT/STLExtras.h"
+#include "llvm/ADT/StringExtras.h"
#include "llvm/ADT/StringRef.h"
#include "llvm/Frontend/OpenMP/OMP.h"
@@ -781,12 +781,15 @@ void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
- const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
+ const auto &endBlockDir{
+ std::get<std::optional<parser::OmpEndBlockDirective>>(x.t)};
const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
- const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
const parser::Block &block{std::get<parser::Block>(x.t)};
- CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
+ if (endBlockDir) {
+ const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir->t)};
+ CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
+ }
PushContextAndClauseSets(beginDir.source, beginDir.v);
if (llvm::omp::allTargetSet.test(GetContext().directive)) {
@@ -836,14 +839,14 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
bool foundNowait{false};
parser::CharBlock NowaitSource;
- auto catchCopyPrivateNowaitClauses = [&](const auto &dir, bool endDir) {
+ auto catchCopyPrivateNowaitClauses = [&](const auto &dir, bool isEnd) {
for (auto &clause : std::get<parser::OmpClauseList>(dir.t).v) {
if (clause.Id() == llvm::omp::Clause::OMPC_copyprivate) {
for (const auto &ompObject : GetOmpObjectList(clause)->v) {
const auto *name{parser::Unwrap<parser::Name>(ompObject)};
if (Symbol * symbol{name->symbol}) {
if (singleCopyprivateSyms.count(symbol)) {
- if (endDir) {
+ if (isEnd) {
context_.Warn(common::UsageWarning::OpenMPUsage, name->source,
"The COPYPRIVATE clause with '%s' is already used on the SINGLE directive"_warn_en_US,
name->ToString());
@@ -857,7 +860,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
"'%s' appears in more than one COPYPRIVATE clause on the END SINGLE directive"_err_en_US,
name->ToString());
} else {
- if (endDir) {
+ if (isEnd) {
endSingleCopyprivateSyms.insert(symbol);
} else {
singleCopyprivateSyms.insert(symbol);
@@ -870,7 +873,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
context_.Say(clause.source,
"At most one NOWAIT clause can appear on the SINGLE directive"_err_en_US);
} else {
- foundNowait = !endDir;
+ foundNowait = !isEnd;
}
if (!NowaitSource.ToString().size()) {
NowaitSource = clause.source;
@@ -879,7 +882,9 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
}
};
catchCopyPrivateNowaitClauses(beginBlockDir, false);
- catchCopyPrivateNowaitClauses(endBlockDir, true);
+ if (endBlockDir) {
+ catchCopyPrivateNowaitClauses(*endBlockDir, true);
+ }
unsigned version{context_.langOptions().OpenMPVersion};
if (version <= 52 && NowaitSource.ToString().size() &&
(singleCopyprivateSyms.size() || endSingleCopyprivateSyms.size())) {
@@ -3398,23 +3403,22 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Detach &x) {
}
}
-void OmpStructureChecker::CheckAllowedMapTypes(
- const parser::OmpMapType::Value &type,
- const std::list<parser::OmpMapType::Value> &allowedMapTypeList) {
- if (!llvm::is_contained(allowedMapTypeList, type)) {
- std::string commaSeparatedMapTypes;
- llvm::interleave(
- allowedMapTypeList.begin(), allowedMapTypeList.end(),
- [&](const parser::OmpMapType::Value &mapType) {
- commaSeparatedMapTypes.append(parser::ToUpperCaseLetters(
- parser::OmpMapType::EnumToString(mapType)));
- },
- [&] { commaSeparatedMapTypes.append(", "); });
- context_.Say(GetContext().clauseSource,
- "Only the %s map types are permitted "
- "for MAP clauses on the %s directive"_err_en_US,
- commaSeparatedMapTypes, ContextDirectiveAsFortran());
+void OmpStructureChecker::CheckAllowedMapTypes(parser::OmpMapType::Value type,
+ llvm::ArrayRef<parser::OmpMapType::Value> allowed) {
+ if (llvm::is_contained(allowed, type)) {
+ return;
}
+
+ llvm::SmallVector<std::string> names;
+ llvm::transform(
+ allowed, std::back_inserter(names), [](parser::OmpMapType::Value val) {
+ return parser::ToUpperCaseLetters(
+ parser::OmpMapType::EnumToString(val));
+ });
+ llvm::sort(names);
+ context_.Say(GetContext().clauseSource,
+ "Only the %s map types are permitted for MAP clauses on the %s directive"_err_en_US,
+ llvm::join(names, ", "), ContextDirectiveAsFortran());
}
void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
@@ -3435,27 +3439,62 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
CheckIteratorModifier(*iter);
}
if (auto *type{OmpGetUniqueModifier<parser::OmpMapType>(modifiers)}) {
+ using Directive = llvm::omp::Directive;
using Value = parser::OmpMapType::Value;
- switch (GetContext().directive) {
- case llvm::omp::Directive::OMPD_target:
- case llvm::omp::Directive::OMPD_target_teams:
- case llvm::omp::Directive::OMPD_target_teams_distribute:
- case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
- case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
- case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
- case llvm::omp::Directive::OMPD_target_data:
- CheckAllowedMapTypes(
- type->v, {Value::To, Value::From, Value::Tofrom, Value::Alloc});
- break;
- case llvm::omp::Directive::OMPD_target_enter_data:
- CheckAllowedMapTypes(type->v, {Value::To, Value::Alloc});
- break;
- case llvm::omp::Directive::OMPD_target_exit_data:
- CheckAllowedMapTypes(
- type->v, {Value::From, Value::Release, Value::Delete});
- break;
- default:
- break;
+
+ static auto isValidForVersion{
+ [](parser::OmpMapType::Value t, unsigned version) {
+ switch (t) {
+ case parser::OmpMapType::Value::Alloc:
+ case parser::OmpMapType::Value::Delete:
+ case parser::OmpMapType::Value::Release:
+ return version < 60;
+ case parser::OmpMapType::Value::Storage:
+ return version >= 60;
+ default:
+ return true;
+ }
+ }};
+
+ llvm::SmallVector<parser::OmpMapType::Value> mapEnteringTypes{[&]() {
+ llvm::SmallVector<parser::OmpMapType::Value> result;
+ for (size_t i{0}; i != parser::OmpMapType::Value_enumSize; ++i) {
+ auto t{static_cast<parser::OmpMapType::Value>(i)};
+ if (isValidForVersion(t, version) && IsMapEnteringType(t)) {
+ result.push_back(t);
+ }
+ }
+ return result;
+ }()};
+ llvm::SmallVector<parser::OmpMapType::Value> mapExitingTypes{[&]() {
+ llvm::SmallVector<parser::OmpMapType::Value> result;
+ for (size_t i{0}; i != parser::OmpMapType::Value_enumSize; ++i) {
+ auto t{static_cast<parser::OmpMapType::Value>(i)};
+ if (isValidForVersion(t, version) && IsMapExitingType(t)) {
+ result.push_back(t);
+ }
+ }
+ 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) {
+ // Map types listed in the decay table. [6.0:276]
+ CheckAllowedMapTypes(
+ type->v, {Value::Storage, Value::From, Value::To, Value::Tofrom});
+ } else {
+ CheckAllowedMapTypes(
+ type->v, {Value::Alloc, Value::From, Value::To, Value::Tofrom});
+ }
+ } else if (llvm::is_contained(leafs, Directive::OMPD_target_enter_data)) {
+ CheckAllowedMapTypes(type->v, mapEnteringTypes);
+ } else if (llvm::is_contained(leafs, Directive::OMPD_target_exit_data)) {
+ CheckAllowedMapTypes(type->v, mapExitingTypes);
}
}
@@ -4116,21 +4155,26 @@ void OmpStructureChecker::CheckArraySection(
// Detect this by looking for array accesses on character variables which are
// not arrays.
bool isSubstring{false};
- evaluate::ExpressionAnalyzer ea{context_};
- if (MaybeExpr expr = ea.Analyze(arrayElement.base)) {
- std::optional<evaluate::Shape> shape = evaluate::GetShape(expr);
- // Not an array: rank 0
- if (shape && shape->size() == 0) {
- if (std::optional<evaluate::DynamicType> type = expr->GetType()) {
- if (type->category() == evaluate::TypeCategory::Character) {
- // Substrings are explicitly denied by the standard [6.0:163:9-11].
- // This is supported as an extension. This restriction was added in
- // OpenMP 5.2.
- isSubstring = true;
- context_.Say(GetContext().clauseSource,
- "The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2."_port_en_US);
- } else {
- llvm_unreachable("Array indexing on a variable that isn't an array");
+ // Cannot analyze a base of an assumed-size array on its own. If we know
+ // this is an array (assumed-size or not) we can ignore it, since we're
+ // looking for strings.
+ if (!IsAssumedSizeArray(*name.symbol)) {
+ evaluate::ExpressionAnalyzer ea{context_};
+ if (MaybeExpr expr = ea.Analyze(arrayElement.base)) {
+ if (expr->Rank() == 0) {
+ // Not an array: rank 0
+ if (std::optional<evaluate::DynamicType> type = expr->GetType()) {
+ if (type->category() == evaluate::TypeCategory::Character) {
+ // Substrings are explicitly denied by the standard [6.0:163:9-11].
+ // This is supported as an extension. This restriction was added in
+ // OpenMP 5.2.
+ isSubstring = true;
+ context_.Say(GetContext().clauseSource,
+ "The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2."_port_en_US);
+ } else {
+ llvm_unreachable(
+ "Array indexing on a variable that isn't an array");
+ }
}
}
}
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 6a877a5..f4a291d 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -179,8 +179,8 @@ private:
void HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct &x);
void HasInvalidLoopBinding(const parser::OpenMPLoopConstruct &x);
// specific clause related
- void CheckAllowedMapTypes(const parser::OmpMapType::Value &,
- const std::list<parser::OmpMapType::Value> &);
+ void CheckAllowedMapTypes(
+ parser::OmpMapType::Value, llvm::ArrayRef<parser::OmpMapType::Value>);
const std::list<parser::OmpTraitProperty> &GetTraitPropertyList(
const parser::OmpTraitSelector &);
diff --git a/flang/lib/Semantics/openmp-modifiers.cpp b/flang/lib/Semantics/openmp-modifiers.cpp
index c84e832..336ce4b 100644
--- a/flang/lib/Semantics/openmp-modifiers.cpp
+++ b/flang/lib/Semantics/openmp-modifiers.cpp
@@ -141,6 +141,22 @@ OmpGetDescriptor<parser::OmpAllocatorSimpleModifier>() {
}
template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpAlwaysModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"always-modifier",
+ /*props=*/
+ {
+ {45, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {45, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpChunkModifier>() {
static const OmpModifierDescriptor desc{
/*name=*/"chunk-modifier",
@@ -157,6 +173,22 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpChunkModifier>() {
}
template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpCloseModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"close-modifier",
+ /*props=*/
+ {
+ {50, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {50, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpContextSelector>() {
static const OmpModifierDescriptor desc{
/*name=*/"context-selector",
@@ -174,6 +206,23 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpContextSelector>() {
}
template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpDeleteModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"delete-modifier",
+ /*props=*/
+ {
+ {45, {OmpProperty::Unique, OmpProperty::Ultimate}},
+ {60, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {45, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpDependenceType>() {
static const OmpModifierDescriptor desc{
/*name=*/"dependence-type",
@@ -347,6 +396,7 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpMapType>() {
/*props=*/
{
{45, {OmpProperty::Ultimate}},
+ {60, {OmpProperty::Unique}},
},
/*clauses=*/
{
@@ -367,6 +417,7 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpMapTypeModifier>() {
/*clauses=*/
{
{45, {Clause::OMPC_map}},
+ {60, {}},
},
};
return desc;
@@ -421,6 +472,22 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpPrescriptiveness>() {
}
template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpPresentModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"present-modifier",
+ /*props=*/
+ {
+ {51, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {51, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
const OmpModifierDescriptor &
OmpGetDescriptor<parser::OmpReductionIdentifier>() {
static const OmpModifierDescriptor desc{
@@ -457,6 +524,38 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpReductionModifier>() {
}
template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpRefModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"ref-modifier",
+ /*props=*/
+ {
+ {60, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {60, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpSelfModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"self-modifier",
+ /*props=*/
+ {
+ {60, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {60, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
+
+template <>
const OmpModifierDescriptor &
OmpGetDescriptor<parser::OmpStepComplexModifier>() {
static const OmpModifierDescriptor desc{
@@ -522,4 +621,20 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpVariableCategory>() {
};
return desc;
}
+
+template <>
+const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpxHoldModifier>() {
+ static const OmpModifierDescriptor desc{
+ /*name=*/"ompx-hold-modifier",
+ /*props=*/
+ {
+ {45, {OmpProperty::Unique}},
+ },
+ /*clauses=*/
+ {
+ {45, {Clause::OMPC_map}},
+ },
+ };
+ return desc;
+}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index f43d2cc..da14507 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -143,6 +143,31 @@ bool IsVarOrFunctionRef(const MaybeExpr &expr) {
}
}
+bool IsMapEnteringType(parser::OmpMapType::Value type) {
+ switch (type) {
+ case parser::OmpMapType::Value::Alloc:
+ case parser::OmpMapType::Value::Storage:
+ case parser::OmpMapType::Value::To:
+ case parser::OmpMapType::Value::Tofrom:
+ return true;
+ default:
+ return false;
+ }
+}
+
+bool IsMapExitingType(parser::OmpMapType::Value type) {
+ switch (type) {
+ case parser::OmpMapType::Value::Delete:
+ case parser::OmpMapType::Value::From:
+ case parser::OmpMapType::Value::Release:
+ case parser::OmpMapType::Value::Storage:
+ case parser::OmpMapType::Value::Tofrom:
+ return true;
+ default:
+ return false;
+ }
+}
+
std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
// ForwardOwningPointer typedExpr
diff --git a/flang/lib/Semantics/openmp-utils.h b/flang/lib/Semantics/openmp-utils.h
index a96c008..001fbeb 100644
--- a/flang/lib/Semantics/openmp-utils.h
+++ b/flang/lib/Semantics/openmp-utils.h
@@ -59,6 +59,9 @@ 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);
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 521c743..4c3e509 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -727,7 +727,9 @@ public:
void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); }
void Post(const parser::OmpMapClause &x) {
- Symbol::Flag ompFlag = Symbol::Flag::OmpMapToFrom;
+ unsigned version{context_.langOptions().OpenMPVersion};
+ std::optional<Symbol::Flag> ompFlag;
+
auto &mods{OmpGetModifiers(x)};
if (auto *mapType{OmpGetUniqueModifier<parser::OmpMapType>(mods)}) {
switch (mapType->v) {
@@ -741,16 +743,33 @@ public:
ompFlag = Symbol::Flag::OmpMapToFrom;
break;
case parser::OmpMapType::Value::Alloc:
- ompFlag = Symbol::Flag::OmpMapAlloc;
- break;
case parser::OmpMapType::Value::Release:
- ompFlag = Symbol::Flag::OmpMapRelease;
+ case parser::OmpMapType::Value::Storage:
+ ompFlag = Symbol::Flag::OmpMapStorage;
break;
case parser::OmpMapType::Value::Delete:
ompFlag = Symbol::Flag::OmpMapDelete;
break;
}
}
+ if (!ompFlag) {
+ if (version >= 60) {
+ // [6.0:275:12-15]
+ // When a map-type is not specified for a clause on which it may be
+ // specified, the map-type defaults to storage if the delete-modifier
+ // is present on the clause or if the list item for which the map-type
+ // is not specified is an assumed-size array.
+ if (OmpGetUniqueModifier<parser::OmpDeleteModifier>(mods)) {
+ ompFlag = Symbol::Flag::OmpMapStorage;
+ }
+ // Otherwise, if delete-modifier is absent, leave ompFlag unset.
+ } else {
+ // [5.2:151:10]
+ // If a map-type is not specified, the map-type defaults to tofrom.
+ ompFlag = Symbol::Flag::OmpMapToFrom;
+ }
+ }
+
const auto &ompObjList{std::get<parser::OmpObjectList>(x.t)};
for (const auto &ompObj : ompObjList.v) {
common::visit(
@@ -759,15 +778,15 @@ public:
if (const auto *name{
semantics::getDesignatorNameIfDataRef(designator)}) {
if (name->symbol) {
- name->symbol->set(ompFlag);
- AddToContextObjectWithDSA(*name->symbol, ompFlag);
- }
- if (name->symbol &&
- semantics::IsAssumedSizeArray(*name->symbol)) {
- context_.Say(designator.source,
- "Assumed-size whole arrays may not appear on the %s "
- "clause"_err_en_US,
- "MAP");
+ name->symbol->set(
+ ompFlag.value_or(Symbol::Flag::OmpMapStorage));
+ AddToContextObjectWithDSA(*name->symbol, *ompFlag);
+ if (semantics::IsAssumedSizeArray(*name->symbol)) {
+ context_.Say(designator.source,
+ "Assumed-size whole arrays may not appear on the %s "
+ "clause"_err_en_US,
+ "MAP");
+ }
}
}
},
@@ -775,7 +794,7 @@ public:
},
ompObj.u);
- ResolveOmpObject(ompObj, ompFlag);
+ ResolveOmpObject(ompObj, ompFlag.value_or(Symbol::Flag::OmpMapStorage));
}
}
@@ -2774,9 +2793,8 @@ void OmpAttributeVisitor::ResolveOmpObject(
}
Symbol::Flag dataMappingAttributeFlags[] = {
Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,
- Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapAlloc,
- Symbol::Flag::OmpMapRelease, Symbol::Flag::OmpMapDelete,
- Symbol::Flag::OmpIsDevicePtr,
+ Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapStorage,
+ Symbol::Flag::OmpMapDelete, Symbol::Flag::OmpIsDevicePtr,
Symbol::Flag::OmpHasDeviceAddr};
Symbol::Flag dataSharingAttributeFlags[] = {
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index b15ed05..6db11aa 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -642,8 +642,7 @@ bool Semantics::Perform() {
return ValidateLabels(context_, program_) &&
parser::CanonicalizeDo(program_) && // force line break
CanonicalizeAcc(context_.messages(), program_) &&
- CanonicalizeOmp(context_.messages(), program_) &&
- CanonicalizeCUDA(program_) &&
+ CanonicalizeOmp(context_, program_) && CanonicalizeCUDA(program_) &&
PerformStatementSemantics(context_, program_) &&
CanonicalizeDirectives(context_.messages(), program_) &&
ModFileWriter{context_}
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 0380207..2259cfc 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -861,8 +861,7 @@ std::string Symbol::OmpFlagToClauseName(Symbol::Flag ompFlag) {
case Symbol::Flag::OmpMapTo:
case Symbol::Flag::OmpMapFrom:
case Symbol::Flag::OmpMapToFrom:
- case Symbol::Flag::OmpMapAlloc:
- case Symbol::Flag::OmpMapRelease:
+ case Symbol::Flag::OmpMapStorage:
case Symbol::Flag::OmpMapDelete:
clauseName = "MAP";
break;