[flang][OpenACC] Relax COMMON block usage restriction in OpenACC directives

flang/include/flang/Semantics/scope.h

@@ -189,8 +189,23 @@ class Scope {
   mapType &commonBlocks() { return commonBlocks_; }
   const mapType &commonBlocks() const { return commonBlocks_; }
   Symbol &MakeCommonBlock(SourceName, SourceName location);
+  bool AddCommonBlock(const SourceName &name, Symbol &cbSymbol);
+
+  /// Find COMMON block in the current scope
+  Symbol *FindCB(const SourceName &name) const {
+    if (const auto it{commonBlocks_.find(name)}; it != commonBlocks_.end()) {
+      return &*it->second;
+    }
+    return nullptr;
+  }
+
+  /// Find COMMON block that is not USE-associated in the current scope
   Symbol *FindCommonBlock(const SourceName &) const;
 
+  /// Find COMMON block in current and surrounding scopes, follow USE
+  /// associations
+  Symbol *FindCommonBlockInScopes(const SourceName &) const;
+
   /// Make a Symbol but don't add it to the scope.
   template <typename D>
   common::IfNoLvalue<Symbol &, D> MakeSymbol(

flang/include/flang/Semantics/symbol.h

@@ -884,7 +884,7 @@ class Symbol {
   const Details &details() const { return details_; }
   // Assign the details of the symbol from one of the variants.
   // Only allowed in certain cases.
-  void set_details(Details &&);
+  void set_details(Details &&, bool force = false);
 
   // Can the details of this symbol be replaced with the given details?
   bool CanReplaceDetails(const Details &details) const;

flang/lib/Semantics/check-declarations.cpp

@@ -2782,7 +2782,10 @@ void CheckHelper::Check(const Scope &scope) {
       Check(*scope.symbol());
     }
     for (const auto &pair : scope.commonBlocks()) {
-      CheckCommonBlock(*pair.second);
+      if (pair.second->has<CommonBlockDetails>()) {
+        // Only process actual COMMON block objects, not their uses
+        CheckCommonBlock(*pair.second);
+      }
     }
     int mainProgCnt{0};
     for (const Scope &child : scope.children()) {

flang/lib/Semantics/compute-offsets.cpp

@@ -207,7 +207,10 @@ void ComputeOffsetsHelper::Compute(Scope &scope) {
   // where COMMON blocks are illegal (C1107 and C1108).
   if (scope.kind() != Scope::Kind::BlockConstruct) {
     for (auto &pair : scope.commonBlocks()) {
-      DoCommonBlock(*pair.second);
+      // Only process actual COMMON block objects, not their uses
+      if (pair.second->has<CommonBlockDetails>()) {
+        DoCommonBlock(*pair.second);
+      }
     }
   }
   for (auto &[symbol, dep] : dependents_) {

flang/lib/Semantics/resolve-directives.cpp

@@ -1695,17 +1695,12 @@ void AccAttributeVisitor::Post(const parser::Name &name) {
 
 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
     const parser::Name *name) {
-  if (auto *prev{name
-              ? GetContext().scope.parent().FindCommonBlock(name->source)
-              : nullptr}) {
-    name->symbol = prev;
-    return prev;
-  }
-  // Check if the Common Block is declared in the current scope
-  if (auto *commonBlockSymbol{
-          name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
-    name->symbol = commonBlockSymbol;
-    return commonBlockSymbol;
+  if (!name) {
+    return nullptr;
+  }
+  if (auto *cb{GetContext().scope.FindCommonBlockInScopes(name->source)}) {
+    name->symbol = cb;
+    return cb;
   }
   return nullptr;
 }
@@ -1755,8 +1750,8 @@ void AccAttributeVisitor::ResolveAccObject(
               }
             } else {
               context_.Say(name.source,
-                  "COMMON block must be declared in the same scoping unit "
-                  "in which the OpenACC directive or clause appears"_err_en_US);
+                  "Could not find COMMON block '%s' used in OpenACC directive"_err_en_US,
+                  name.ToString());
             }
           },
       },

flang/lib/Semantics/resolve-names.cpp

@@ -3627,6 +3627,17 @@ void ModuleVisitor::Post(const parser::UseStmt &x) {
       }
     }
   }
+  // Go through the list of COMMON block symbols in the module scope and add
+  // their USE association to the current scope's COMMON blocks.
+  for (const auto &[name, symbol] : useModuleScope_->commonBlocks()) {
+    if (auto *localCB{currScope().FindCommonBlockInScopes(name)}; !localCB) {
+      // Make a symbol, but don't add it to the Scope, since it needs to
+      // be added to the COMMON blocks
+      localCB = &currScope().MakeSymbol(
+          name, symbol->attrs(), UseDetails{name, symbol->GetUltimate()});
+      currScope().AddCommonBlock(name, *localCB);
+    }
+  }
   useModuleScope_ = nullptr;
 }
 
@@ -7284,6 +7295,10 @@ void DeclarationVisitor::CheckCommonBlocks() {
   // check for empty common blocks
   for (const auto &pair : currScope().commonBlocks()) {
     const auto &symbol{*pair.second};
+    if (!pair.second->has<CommonBlockDetails>()) {
+      // Skip USE associated COMMON blocks
+      continue;
+    }
     if (symbol.get<CommonBlockDetails>().objects().empty() &&
         symbol.attrs().test(Attr::BIND_C)) {
       Say(symbol.name(),

flang/lib/Semantics/scope.cpp

@@ -144,19 +144,58 @@ void Scope::add_crayPointer(const SourceName &name, Symbol &pointer) {
 }
 
 Symbol &Scope::MakeCommonBlock(SourceName name, SourceName location) {
-  const auto it{commonBlocks_.find(name)};
-  if (it != commonBlocks_.end()) {
-    return *it->second;
+  if (auto *cb{FindCB(name)}) {
+    if (cb->has<UseDetails>()) {
+      // COMMON blocks could be re-declared. Example:
+      //    module test
+      //      integer :: a
+      //      common /blk/ a
+      //    end module test
+      //    program main
+      //      use test          ! Initially get /blk/ with UseDetails
+      //      integer :: a1
+      //      common /blk/ a1   ! Update with CommonBlockDetails
+      //    end program main
+      // Reset details with real COMMON block details.
+      cb->set_details(CommonBlockDetails{name.empty() ? location : name},
+          /*force*/ true);
+    }
+    return *cb;
   } else {
     Symbol &symbol{MakeSymbol(
         name, Attrs{}, CommonBlockDetails{name.empty() ? location : name})};
     commonBlocks_.emplace(name, symbol);
     return symbol;
   }
 }
+
 Symbol *Scope::FindCommonBlock(const SourceName &name) const {
-  const auto it{commonBlocks_.find(name)};
-  return it != commonBlocks_.end() ? &*it->second : nullptr;
+  if (auto *cb{FindCB(name)}) {
+    // Ensure this COMMON block is not USE-associated
+    if (cb->has<UseDetails>()) {
+      cb = nullptr;
+    }
+    return cb;
+  }
+  return nullptr;
+}
+
+Symbol *Scope::FindCommonBlockInScopes(const SourceName &name) const {
+  if (auto *cb{FindCB(name)}) {
+    return &cb->GetUltimate();
+  } else if (IsSubmodule()) {
+    if (const Scope *parent{
+            symbol_ ? symbol_->get<ModuleDetails>().parent() : nullptr}) {
+      if (auto *cb{parent->FindCommonBlockInScopes(name)}) {
+        return &cb->GetUltimate();
+      }
+    }
+  } else if (!IsTopLevel() && parent_) {
+    if (auto *cb{parent_->FindCommonBlockInScopes(name)}) {
+      return &cb->GetUltimate();
+    }
+  }
+  return nullptr;
 }
 
 Scope *Scope::FindSubmodule(const SourceName &name) const {
@@ -167,6 +206,11 @@ Scope *Scope::FindSubmodule(const SourceName &name) const {
     return &*it->second;
   }
 }
+
+bool Scope::AddCommonBlock(const SourceName &name, Symbol &cbSymbol) {
+  return commonBlocks_.emplace(name, cbSymbol).second;
+}
+
 bool Scope::AddSubmodule(const SourceName &name, Scope &submodule) {
   return submodules_.emplace(name, submodule).second;
 }

flang/lib/Semantics/symbol.cpp

@@ -317,8 +317,10 @@ std::string DetailsToString(const Details &details) {
 
 std::string Symbol::GetDetailsName() const { return DetailsToString(details_); }
 
-void Symbol::set_details(Details &&details) {
-  CHECK(CanReplaceDetails(details));
+void Symbol::set_details(Details &&details, bool force) {
+  if (!force) {
+    CHECK(CanReplaceDetails(details));
+  }
   details_ = std::move(details);
 }
 

flang/test/Semantics/OpenACC/acc-common.f90

@@ -0,0 +1,19 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+module acc_common_decl
+  implicit none
+  integer a
+  common /a_common/ a
+!$acc declare create (/a_common/)
+  data a/42/
+end module acc_common_decl
+
+program acc_decl_test
+  use acc_common_decl
+  implicit none
+
+  a = 1
+!$acc update device (/a_common/)
+  a = 2
+!ERROR: Could not find COMMON block 'a_common_bad' used in OpenACC directive
+!$acc update device (/a_common_bad/)
+end program