[flang-commits] [flang] d89de09 - [flang][OpenMP] Reject blank common blocks more gracefully (#159626)
via flang-commits
flang-commits at lists.llvm.org
Mon Sep 22 07:56:34 PDT 2025
Author: Krzysztof Parzyszek
Date: 2025-09-22T09:56:31-05:00
New Revision: d89de09cb1e51dd0da77734d787628b3db4cd665
URL: https://github.com/llvm/llvm-project/commit/d89de09cb1e51dd0da77734d787628b3db4cd665
DIFF: https://github.com/llvm/llvm-project/commit/d89de09cb1e51dd0da77734d787628b3db4cd665.diff
LOG: [flang][OpenMP] Reject blank common blocks more gracefully (#159626)
Parse them as "invalid" OmpObjects, then emit a diagnostic in semantic
checks.
Added:
flang/test/Semantics/OpenMP/blank-common-block.f90
Modified:
flang/include/flang/Parser/dump-parse-tree.h
flang/include/flang/Parser/parse-tree.h
flang/lib/Parser/openmp-parsers.cpp
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/check-omp-loop.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/openmp-utils.cpp
flang/lib/Semantics/resolve-directives.cpp
flang/lib/Semantics/resolve-names.cpp
Removed:
flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90
################################################################################
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index c053ff1cebb2e..b2341226c7688 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -633,6 +633,8 @@ class ParseTreeDumper {
NODE(parser, OmpNumTasksClause)
NODE(OmpNumTasksClause, Modifier)
NODE(parser, OmpObject)
+ NODE(OmpObject, Invalid)
+ NODE_ENUM(OmpObject::Invalid, Kind)
NODE(parser, OmpObjectList)
NODE(parser, OmpOrderClause)
NODE(OmpOrderClause, Modifier)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index bd0debe297916..40ecd73697d0a 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3505,8 +3505,15 @@ struct OmpDirectiveName {
// in slashes). An extended list item is a list item or a procedure Name.
// variable-name | / common-block / | array-sections
struct OmpObject {
+ // Blank common blocks are not valid objects. Parse them to emit meaningful
+ // diagnostics.
+ struct Invalid {
+ ENUM_CLASS(Kind, BlankCommonBlock);
+ WRAPPER_CLASS_BOILERPLATE(Invalid, Kind);
+ CharBlock source;
+ };
UNION_CLASS_BOILERPLATE(OmpObject);
- std::variant<Designator, /*common block*/ Name> u;
+ std::variant<Designator, /*common block*/ Name, Invalid> u;
};
WRAPPER_CLASS(OmpObjectList, std::list<OmpObject>);
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 8ab9905123135..24d43171d5d9f 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -1024,8 +1024,11 @@ TYPE_PARSER(construct<OmpNumTasksClause>(
maybe(nonemptyList(Parser<OmpNumTasksClause::Modifier>{}) / ":"),
scalarIntExpr))
-TYPE_PARSER(
- construct<OmpObject>(designator) || "/" >> construct<OmpObject>(name) / "/")
+TYPE_PARSER( //
+ construct<OmpObject>(designator) ||
+ "/" >> construct<OmpObject>(name) / "/" ||
+ construct<OmpObject>(sourced(construct<OmpObject::Invalid>(
+ "//"_tok >> pure(OmpObject::Invalid::Kind::BlankCommonBlock)))))
// OMP 5.0 2.19.4.5 LASTPRIVATE ([lastprivate-modifier :] list)
TYPE_PARSER(construct<OmpLastprivateClause>(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 9d73bcafa0e15..e912ee3f7bffc 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2168,10 +2168,22 @@ class UnparseVisitor {
void Unparse(const OmpContextSelectorSpecification &x) { Walk(x.v, ", "); }
void Unparse(const OmpObject &x) {
- common::visit(common::visitors{
- [&](const Designator &y) { Walk(y); },
- [&](const Name &y) { Put("/"), Walk(y), Put("/"); },
- },
+ common::visit( //
+ common::visitors{
+ [&](const Designator &y) { Walk(y); },
+ [&](const Name &y) {
+ Put("/");
+ Walk(y);
+ Put("/");
+ },
+ [&](const OmpObject::Invalid &y) {
+ switch (y.v) {
+ case OmpObject::Invalid::Kind::BlankCommonBlock:
+ Put("//");
+ break;
+ }
+ },
+ },
x.u);
}
void Unparse(const OmpDirectiveNameModifier &x) {
diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp
index 562bd1b4e79a4..c9d0495850b6e 100644
--- a/flang/lib/Semantics/check-omp-loop.cpp
+++ b/flang/lib/Semantics/check-omp-loop.cpp
@@ -491,7 +491,10 @@ void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
checkReductionSymbolInScan(name);
}
},
- [&](const auto &name) { checkReductionSymbolInScan(&name); },
+ [&](const parser::Name &name) {
+ checkReductionSymbolInScan(&name);
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObj.u);
}
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index c39daef6b0ea9..39c6f9bda774d 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -269,7 +269,8 @@ bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
}
void OmpStructureChecker::AnalyzeObject(const parser::OmpObject &object) {
- if (std::holds_alternative<parser::Name>(object.u)) {
+ if (std::holds_alternative<parser::Name>(object.u) ||
+ std::holds_alternative<parser::OmpObject::Invalid>(object.u)) {
// Do not analyze common block names. The analyzer will flag an error
// on those.
return;
@@ -294,7 +295,12 @@ void OmpStructureChecker::AnalyzeObject(const parser::OmpObject &object) {
}
evaluate::ExpressionAnalyzer ea{context_};
auto restore{ea.AllowWholeAssumedSizeArray(true)};
- common::visit([&](auto &&s) { ea.Analyze(s); }, object.u);
+ common::visit( //
+ common::visitors{
+ [&](auto &&s) { ea.Analyze(s); },
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
+ object.u);
}
void OmpStructureChecker::AnalyzeObjects(const parser::OmpObjectList &objects) {
@@ -538,6 +544,7 @@ void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
[&](const parser::Name &name) {
CheckPredefinedAllocatorRestriction(source, name);
},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -1290,7 +1297,11 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
const parser::OmpObjectList &objList) {
for (const auto &ompObject : objList.v) {
- common::visit([&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },
+ common::visit( //
+ common::visitors{
+ [&](auto &&s) { CheckThreadprivateOrDeclareTargetVar(s); },
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
ompObject.u);
}
}
@@ -1422,8 +1433,14 @@ void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
// refer to the same depend object as the depobj argument of the construct.
if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {
auto getObjSymbol{[&](const parser::OmpObject &obj) {
- return common::visit(
- [&](auto &&s) { return GetLastName(s).symbol; }, obj.u);
+ return common::visit( //
+ common::visitors{
+ [&](auto &&s) { return GetLastName(s).symbol; },
+ [&](const parser::OmpObject::Invalid &invalid) {
+ return static_cast<Symbol *>(nullptr);
+ },
+ },
+ obj.u);
}};
auto getArgSymbol{[&](const parser::OmpArgument &arg) {
if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {
@@ -1438,9 +1455,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {
const Symbol *constrSym{getArgSymbol(arguments.v.front())};
const Symbol *clauseSym{getObjSymbol(destroy->v)};
- assert(constrSym && "Unresolved depobj construct symbol");
- assert(clauseSym && "Unresolved destroy symbol on depobj construct");
- if (constrSym != clauseSym) {
+ if (constrSym && clauseSym && constrSym != clauseSym) {
context_.Say(x.source,
"The DESTROY clause must refer to the same object as the "
"DEPOBJ construct"_err_en_US);
@@ -1678,6 +1693,7 @@ void OmpStructureChecker::CheckSymbolNames(
ContextDirectiveAsFortran());
}
},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -2698,6 +2714,7 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
}
}
},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -3405,6 +3422,7 @@ void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
}
},
[&](const parser::Name &name) {},
+ [&](const parser::OmpObject::Invalid &invalid) {},
},
ompObject.u);
}
@@ -4090,11 +4108,11 @@ void OmpStructureChecker::CheckStructureComponent(
}};
for (const auto &object : objects.v) {
- common::visit(
- common::visitors{
- CheckComponent,
- [&](const parser::Name &name) {},
- },
+ common::visit(common::visitors{
+ CheckComponent,
+ [&](const parser::Name &name) {},
+ [&](const parser::OmpObject::Invalid &invalid) {},
+ },
object.u);
}
}
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 2980f827d3ef3..c62a1b33ed4e8 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -225,7 +225,7 @@ struct ContiguousHelper {
std::optional<bool> IsContiguous(
SemanticsContext &semaCtx, const parser::OmpObject &object) {
return common::visit( //
- common::visitors{
+ common::visitors{//
[&](const parser::Name &x) {
// Any member of a common block must be contiguous.
return std::optional<bool>{true};
@@ -237,7 +237,9 @@ std::optional<bool> IsContiguous(
}
return std::optional<bool>{};
},
- },
+ [&](const parser::OmpObject::Invalid &) {
+ return std::optional<bool>{};
+ }},
object.u);
}
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 2d1bec9968593..570649995edb0 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3121,14 +3121,24 @@ void OmpAttributeVisitor::ResolveOmpCommonBlock(
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);
- },
- },
+ common::visit( //
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ ResolveOmpDesignator(designator, ompFlag);
+ },
+ [&](const parser::Name &name) { // common block
+ ResolveOmpCommonBlock(name, ompFlag);
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {
+ switch (invalid.v) {
+ SWITCH_COVERS_ALL_CASES
+ case parser::OmpObject::Invalid::Kind::BlankCommonBlock:
+ context_.Say(invalid.source,
+ "Blank common blocks are not allowed as directive or clause arguments"_err_en_US);
+ break;
+ }
+ },
+ },
ompObject.u);
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index cdd8d6ff2f60e..e97f0bf02a515 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1625,25 +1625,33 @@ class OmpVisitor : public virtual DeclarationVisitor {
void Post(const parser::OpenMPThreadprivate &) { SkipImplicitTyping(false); }
bool Pre(const parser::OpenMPDeclareTargetConstruct &x) {
const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
- auto populateDeclareTargetNames{
- [this](const parser::OmpObjectList &objectList) {
- for (const auto &ompObject : objectList.v) {
- common::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *name{
- semantics::getDesignatorNameIfDataRef(
- designator)}) {
- specPartState_.declareTargetNames.insert(name->source);
- }
- },
- [&](const parser::Name &name) {
- specPartState_.declareTargetNames.insert(name.source);
- },
+ auto populateDeclareTargetNames{[this](const parser::OmpObjectList
+ &objectList) {
+ for (const auto &ompObject : objectList.v) {
+ common::visit(
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ if (const auto *name{
+ semantics::getDesignatorNameIfDataRef(designator)}) {
+ specPartState_.declareTargetNames.insert(name->source);
+ }
},
- ompObject.u);
- }
- }};
+ [&](const parser::Name &name) {
+ specPartState_.declareTargetNames.insert(name.source);
+ },
+ [&](const parser::OmpObject::Invalid &invalid) {
+ switch (invalid.v) {
+ SWITCH_COVERS_ALL_CASES
+ case parser::OmpObject::Invalid::Kind::BlankCommonBlock:
+ context().Say(invalid.source,
+ "Blank common blocks are not allowed as directive or clause arguments"_err_en_US);
+ break;
+ }
+ },
+ },
+ ompObject.u);
+ }
+ }};
if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
populateDeclareTargetNames(*objectList);
diff --git a/flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90 b/flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90
deleted file mode 100644
index 6317258e6ec8d..0000000000000
--- a/flang/test/Parser/OpenMP/threadprivate-blank-common-block.f90
+++ /dev/null
@@ -1,9 +0,0 @@
-! RUN: not %flang_fc1 -fsyntax-only %s -fopenmp 2>&1 | FileCheck %s
-! From Standard: A blank common block cannot appear in a threadprivate directive.
-
-program main
- integer :: a
- common//a
- !CHECK: error: expected one of '$@ABCDEFGHIJKLMNOPQRSTUVWXYZ_'
- !$omp threadprivate(//)
- end
diff --git a/flang/test/Semantics/OpenMP/blank-common-block.f90 b/flang/test/Semantics/OpenMP/blank-common-block.f90
new file mode 100644
index 0000000000000..4a217fced0ff7
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/blank-common-block.f90
@@ -0,0 +1,18 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+module m
+ integer :: a
+ common // a
+ !ERROR: Blank common blocks are not allowed as directive or clause arguments
+ !$omp declare_target(//)
+ !ERROR: Blank common blocks are not allowed as directive or clause arguments
+ !$omp threadprivate(//)
+end
+
+subroutine f00
+ integer :: a
+ common // a
+ !ERROR: Blank common blocks are not allowed as directive or clause arguments
+ !$omp parallel shared(//)
+ !$omp end parallel
+end
More information about the flang-commits
mailing list