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

flang/include/flang/Semantics/scope.h

@@ -189,7 +189,29 @@ class Scope {
   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, Symbol &cbSymbol);
+  mapType &commonBlockUses() { return commonBlockUses_; }
+
+  // Find COMMON block that is not USE-associated 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 *FindCommonBlockInSurroundingScopes(const SourceName &) const;
 
   /// Make a Symbol but don't add it to the scope.
   template <typename D>
@@ -283,6 +305,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

@@ -1729,17 +1729,13 @@ 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.FindCommonBlockInSurroundingScopes(
+          name->source)}) {
+    name->symbol = cb;
+    return cb;
   }
   return nullptr;
 }
@@ -1789,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,28 @@ 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 (Symbol *localCB{currScope().FindCommonBlockInSurroundingScopes(name)};
+        !localCB) {
+      // Make a symbol, but don't add it to the Scope, since it needs to
+      // be added to the USE-associated COMMON blocks
+      localCB = &currScope().MakeSymbol(
+          name, symbol->attrs(), UseDetails{name, symbol->GetUltimate()});
+      currScope().AddCommonBlockUse(name, *localCB);
+    }
+  }
+  // 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()) {
+    // Make a symbol, but don't add it to the Scope, since it needs to
+    // be added to the USE-associated COMMON blocks
+    Symbol *localCB = &currScope().MakeSymbol(
+        name, symbol->attrs(), UseDetails{name, symbol->GetUltimate()});
+    currScope().AddCommonBlockUse(name, *localCB);
+  }
   useModuleScope_ = nullptr;
 }
 

flang/lib/Semantics/scope.cpp

@@ -144,19 +144,35 @@ 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::FindCommonBlockInSurroundingScopes(
+    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->FindCommonBlockInSurroundingScopes(name)}) {
+        return cb;
+      }
+    }
+  } else if (!IsTopLevel() && parent_) {
+    if (auto *cb{parent_->FindCommonBlockInSurroundingScopes(name)}) {
+      return cb;
+    }
+  }
+  return nullptr;
 }
 
 Scope *Scope::FindSubmodule(const SourceName &name) const {
@@ -167,6 +183,11 @@ Scope *Scope::FindSubmodule(const SourceName &name) const {
     return &*it->second;
   }
 }
+
+bool Scope::AddCommonBlockUse(const SourceName &name, Symbol &cbSymbol) {
+  return commonBlockUses_.emplace(name, cbSymbol).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,30 @@
+! 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_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
+  implicit none
+
+  a = 1
+  b = 10
+!$acc update device (/a_common/)
+  a = 2
+!$acc update device (/b_common/)
+  b = 20
+!ERROR: Could not find COMMON block 'a_common_bad' used in OpenACC directive
+!$acc update device (/a_common_bad/)
+end program