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

flang/include/flang/Semantics/scope.h

@@ -86,6 +86,13 @@ class Scope {
     CHECK(parent_ != this);
     return *parent_;
   }
+
+  mapType &commonBlocks() { return commonBlocks_; }
+  const mapType &commonBlocks() const { return commonBlocks_; }
+
+  mapType &commonBlockUses() { return commonBlockUses_; }
+  const mapType &commonBlockUses() const { return commonBlockUses_; }
+
   Kind kind() const { return kind_; }
   bool IsGlobal() const { return kind_ == Kind::Global; }
   bool IsIntrinsicModules() const { return kind_ == Kind::IntrinsicModules; }
@@ -186,10 +193,30 @@ class Scope {
   // Cray pointers are saved as map of pointee name -> pointer symbol
   const mapType &crayPointers() const { return crayPointers_; }
   void add_crayPointer(const SourceName &, Symbol &);
-  mapType &commonBlocks() { return commonBlocks_; }
-  const mapType &commonBlocks() const { return commonBlocks_; }
   Symbol &MakeCommonBlock(SourceName, SourceName location);
-  Symbol *FindCommonBlock(const SourceName &) const;
+  bool AddCommonBlockUse(
+      const SourceName &name, Attrs attrs, Symbol &cbUltimate);
+
+  // Find COMMON block that is declared in the current scope
+  Symbol *FindCommonBlock(const SourceName &name) const {
+    if (const auto it{commonBlocks_.find(name)}; it != commonBlocks_.end()) {
+      return &*it->second;
+    }
+    return nullptr;
+  }
+
+  // Find USE-associated COMMON block in the current scope
+  Symbol *FindCommonBlockUse(const SourceName &name) const {
+    if (const auto it{commonBlockUses_.find(name)};
+        it != commonBlockUses_.end()) {
+      return &*it->second;
+    }
+    return nullptr;
+  }
+
+  // Find COMMON block in current and surrounding scopes, follow USE
+  // associations
+  Symbol *FindCommonBlockInVisibleScopes(const SourceName &) const;
 
   /// Make a Symbol but don't add it to the scope.
   template <typename D>
@@ -283,6 +310,7 @@ class Scope {
   std::list<Scope> children_;
   mapType symbols_;
   mapType commonBlocks_;
+  mapType commonBlockUses_; // USE-assocated COMMON blocks
   std::list<EquivalenceSet> equivalenceSets_;
   mapType crayPointers_;
   std::map<SourceName, common::Reference<Scope>> submodules_;

flang/lib/Semantics/resolve-directives.cpp

@@ -1730,17 +1730,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) {
+    if (Symbol *
+        cb{GetContext().scope.FindCommonBlockInVisibleScopes(name->source)}) {
+      name->symbol = cb;
+      return cb;
+    }
   }
   return nullptr;
 }
@@ -1790,8 +1785,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,20 @@ 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 USE-associated COMMON blocks.
+  for (const auto &[name, symbol] : useModuleScope_->commonBlocks()) {
+    if (!currScope().FindCommonBlockInVisibleScopes(name)) {
+      currScope().AddCommonBlockUse(
+          name, symbol->attrs(), symbol->GetUltimate());
+    }
+  }
+  // Go through the list of USE-associated COMMON block symbols in the module
+  // scope and add USE associations to their ultimate symbols to the current
+  // scope's USE-associated COMMON blocks.
+  for (const auto &[name, symbol] : useModuleScope_->commonBlockUses()) {
+    currScope().AddCommonBlockUse(name, symbol->attrs(), symbol->GetUltimate());
+  }
   useModuleScope_ = nullptr;
 }
 

flang/lib/Semantics/scope.cpp

@@ -144,19 +144,34 @@ 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{FindCommonBlock(name)}) {
+    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;
+
+Symbol *Scope::FindCommonBlockInVisibleScopes(const SourceName &name) const {
+  if (Symbol * cb{FindCommonBlock(name)}) {
+    return cb;
+  } else if (Symbol * cb{FindCommonBlockUse(name)}) {
+    return &cb->GetUltimate();
+  } else if (IsSubmodule()) {
+    if (const Scope *parent{
+            symbol_ ? symbol_->get<ModuleDetails>().parent() : nullptr}) {
+      if (auto *cb{parent->FindCommonBlockInVisibleScopes(name)}) {
+        return cb;
+      }
+    }
+  } else if (!IsTopLevel() && parent_) {
+    if (auto *cb{parent_->FindCommonBlockInVisibleScopes(name)}) {
+      return cb;
+    }
+  }
+  return nullptr;
 }
 
 Scope *Scope::FindSubmodule(const SourceName &name) const {
@@ -167,6 +182,16 @@ Scope *Scope::FindSubmodule(const SourceName &name) const {
     return &*it->second;
   }
 }
+
+bool Scope::AddCommonBlockUse(
+    const SourceName &name, Attrs attrs, Symbol &cbUltimate) {
+  CHECK(cbUltimate.has<CommonBlockDetails>());
+  // Make a symbol, but don't add it to the Scope, since it needs to
+  // be added to the USE-associated COMMON blocks
+  Symbol &useCB{MakeSymbol(name, attrs, UseDetails{name, cbUltimate})};
+  return commonBlockUses_.emplace(name, useCB).second;
+}
+
 bool Scope::AddSubmodule(const SourceName &name, Scope &submodule) {
   return submodules_.emplace(name, submodule).second;
 }

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

@@ -0,0 +1,41 @@
+! 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
+
+module acc_common_another
+  implicit none
+  integer c, d
+  common /a_common/ c, d
+!$acc declare create (/a_common/)
+end module acc_common_another
+
+module acc_common_intermediate
+  use acc_common_decl
+  implicit none
+  integer b
+  common /b_common/ b
+!$acc declare create (/b_common/)
+end module acc_common_intermediate
+
+program acc_decl_test
+  use acc_common_intermediate
+  use acc_common_another
+  implicit none
+
+  a = 1
+  b = 10
+!$acc update device (/a_common/)
+  a = 2
+!$acc update device (/b_common/)
+  b = 20
+!$acc update device (/a_common/)
+  c = 3
+  d = 30
+!ERROR: Could not find COMMON block 'a_common_bad' used in OpenACC directive
+!$acc update device (/a_common_bad/)
+end program