diff --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h index 3195892fa7b91..77edfe16e3010 100644 --- a/flang/include/flang/Semantics/scope.h +++ b/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 @@ -283,6 +310,7 @@ class Scope { std::list children_; mapType symbols_; mapType commonBlocks_; + mapType commonBlockUses_; // USE-assocated COMMON blocks std::list equivalenceSets_; mapType crayPointers_; std::map> submodules_; diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 33e9ea5a89efd..6f3bdc5297997 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/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()); } }, }, diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 0af1c94502bb4..c5043af2ebdca 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/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; } diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp index 4af371f3611f3..b19bb94a3c65c 100644 --- a/flang/lib/Semantics/scope.cpp +++ b/flang/lib/Semantics/scope.cpp @@ -144,9 +144,8 @@ 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})}; @@ -154,9 +153,25 @@ Symbol &Scope::MakeCommonBlock(SourceName name, SourceName location) { 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().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()); + // 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; } diff --git a/flang/test/Semantics/OpenACC/acc-common.f90 b/flang/test/Semantics/OpenACC/acc-common.f90 new file mode 100644 index 0000000000000..31c4d190d576b --- /dev/null +++ b/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