[flang][OpenMP] Reject blank common blocks more gracefully

flang/include/flang/Parser/dump-parse-tree.h

@@ -634,6 +634,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)

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>);

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>(

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) {

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);
         }

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);
   }
@@ -1302,7 +1309,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);
   }
 }
@@ -1434,8 +1445,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)}) {
@@ -1450,9 +1467,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);
@@ -1690,6 +1705,7 @@ void OmpStructureChecker::CheckSymbolNames(
                     ContextDirectiveAsFortran());
               }
             },
+            [&](const parser::OmpObject::Invalid &invalid) {},
         },
         ompObject.u);
   }
@@ -2710,6 +2726,7 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
                       }
                     }
                   },
+                  [&](const parser::OmpObject::Invalid &invalid) {},
               },
               ompObject.u);
         }
@@ -3417,6 +3434,7 @@ void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
             }
           },
           [&](const parser::Name &name) {},
+          [&](const parser::OmpObject::Invalid &invalid) {},
       },
       ompObject.u);
 }
@@ -4102,11 +4120,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);
   }
 }

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);
 }
 

flang/lib/Semantics/resolve-directives.cpp

@@ -3123,14 +3123,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);
 }
 

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);

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