diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index 1abe6cbffcf2..07103f98ff04 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -241,6 +241,8 @@ inline bool NeedCUDAAlloc(const Symbol &sym) { const Scope *FindCUDADeviceContext(const Scope *); std::optional GetCUDADataAttr(const Symbol *); +bool IsAccessible(const Symbol &, const Scope &); + // Return an error if a symbol is not accessible from a scope std::optional CheckAccessibleSymbol( const Scope &, const Symbol &); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 99c6e16c4260..a7e6cf32e85e 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2742,6 +2742,9 @@ void CheckHelper::CheckBlockData(const Scope &scope) { void CheckHelper::CheckGenericOps(const Scope &scope) { DistinguishabilityHelper helper{context_}; auto addSpecifics{[&](const Symbol &generic) { + if (!IsAccessible(generic, scope)) { + return; + } const auto *details{generic.GetUltimate().detailsIf()}; if (!details) { // Not a generic; ensure characteristics are defined if a function. diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 3832876aca75..052d71be4347 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -550,9 +550,7 @@ const Symbol *FindOverriddenBinding( if (const Symbol * overridden{parentScope->FindComponent(symbol.name())}) { // 7.5.7.3 p1: only accessible bindings are overridden - if (!overridden->attrs().test(Attr::PRIVATE) || - FindModuleContaining(overridden->owner()) == - FindModuleContaining(symbol.owner())) { + if (IsAccessible(*overridden, symbol.owner())) { return overridden; } else if (overridden->attrs().test(Attr::DEFERRED)) { isInaccessibleDeferred = true; @@ -1126,23 +1124,31 @@ std::optional GetCUDADataAttr(const Symbol *symbol) { return object ? object->cudaDataAttr() : std::nullopt; } +bool IsAccessible(const Symbol &original, const Scope &scope) { + const Symbol &ultimate{original.GetUltimate()}; + if (ultimate.attrs().test(Attr::PRIVATE)) { + const Scope *module{FindModuleContaining(ultimate.owner())}; + return !module || module->Contains(scope); + } else { + return true; + } +} + std::optional CheckAccessibleSymbol( const Scope &scope, const Symbol &symbol) { - if (symbol.attrs().test(Attr::PRIVATE)) { - if (FindModuleFileContaining(scope)) { - // Don't enforce component accessibility checks in module files; - // there may be forward-substituted named constants of derived type - // whose structure constructors reference private components. - } else if (const Scope * - moduleScope{FindModuleContaining(symbol.owner())}) { - if (!moduleScope->Contains(scope)) { - return parser::MessageFormattedText{ - "PRIVATE name '%s' is only accessible within module '%s'"_err_en_US, - symbol.name(), moduleScope->GetName().value()}; - } - } + if (IsAccessible(symbol, scope)) { + return std::nullopt; + } else if (FindModuleFileContaining(scope)) { + // Don't enforce component accessibility checks in module files; + // there may be forward-substituted named constants of derived type + // whose structure constructors reference private components. + return std::nullopt; + } else { + return parser::MessageFormattedText{ + "PRIVATE name '%s' is only accessible within module '%s'"_err_en_US, + symbol.name(), + DEREF(FindModuleContaining(symbol.owner())).GetName().value()}; } - return std::nullopt; } SymbolVector OrderParameterNames(const Symbol &typeSymbol) { diff --git a/flang/test/Semantics/generic12.f90 b/flang/test/Semantics/generic12.f90 new file mode 100644 index 000000000000..1ac76c13b7a2 --- /dev/null +++ b/flang/test/Semantics/generic12.f90 @@ -0,0 +1,30 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +module m + type t + contains + procedure :: tweedledee + generic :: operator(.ga.) => tweedledee + generic, private :: operator(.gb.) => tweedledee + end type + interface operator(.gc.) + module procedure tweedledum + end interface + contains + integer function tweedledee(x,y) + class(t), intent(in) :: x, y + tweedledee = 1 + end + integer function tweedledum(x,y) + class(t), intent(in) :: x, y + tweedledum = 2 + end +end + +module badDueToAccessibility + !ERROR: Generic 'OPERATOR(.ga.)' may not have specific procedures 'tweedledum' and 't%tweedledee' as their interfaces are not distinguishable + use m, operator(.ga.) => operator(.gc.) +end + +module goodDueToInaccessibility + use m, operator(.gb.) => operator(.gc.) +end