[flang-commits] [flang] 1bd083b - [flang] Create names to allow access to inaccessible specifics
peter klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jan 15 16:56:49 PST 2021
Author: peter klausler
Date: 2021-01-15T16:56:38-08:00
New Revision: 1bd083b5d6d0619f532a7310e72887ea6d2e87eb
URL: https://github.com/llvm/llvm-project/commit/1bd083b5d6d0619f532a7310e72887ea6d2e87eb
DIFF: https://github.com/llvm/llvm-project/commit/1bd083b5d6d0619f532a7310e72887ea6d2e87eb.diff
LOG: [flang] Create names to allow access to inaccessible specifics
When a reference to a generic interface occurs in a specification
expression that must be emitted to a module file, we have a problem
when the generic resolves to a function whose name is inaccessible
due to being PRIVATE or due to a conflict with another use of the
same name in the scope. In these cases, construct a new name for
the specific procedure and emit a renaming USE to the module file.
Also, relax enforcement of PRIVATE when analyzing module files.
Differential Revision: https://reviews.llvm.org/D94815
Added:
flang/test/Semantics/modfile39.f90
Modified:
flang/include/flang/Semantics/expression.h
flang/include/flang/Semantics/semantics.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/semantics.cpp
flang/lib/Semantics/tools.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index e095928656a8..7b252baa6c7d 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -363,6 +363,8 @@ class ExpressionAnalyzer {
const Symbol *ResolveGeneric(const Symbol &, const ActualArguments &,
const AdjustActuals &, bool mightBeStructureConstructor = false);
void EmitGenericResolutionError(const Symbol &);
+ const Symbol &AccessSpecific(
+ const Symbol &originalGeneric, const Symbol &specific);
std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
ActualArguments &&, bool isSubroutine = false,
bool mightBeStructureConstructor = false);
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index de3d9aeac144..4f4bfc7fea2d 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -16,6 +16,7 @@
#include "flang/Evaluate/intrinsics.h"
#include "flang/Parser/message.h"
#include <iosfwd>
+#include <set>
#include <string>
#include <vector>
@@ -170,6 +171,7 @@ class SemanticsContext {
void ActivateIndexVar(const parser::Name &, IndexVarKind);
void DeactivateIndexVar(const parser::Name &);
SymbolVector GetIndexVars(IndexVarKind);
+ SourceName SaveTempName(std::string &&);
SourceName GetTempName(const Scope &);
private:
@@ -198,7 +200,7 @@ class SemanticsContext {
};
std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
std::set<SymbolRef> errorSymbols_;
- std::vector<std::string> tempNames_;
+ std::set<std::string> tempNames_;
};
class Semantics {
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 1a0e2845534b..e809b300b3ad 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -38,6 +38,7 @@ const Scope &GetProgramUnitContaining(const Scope &);
const Scope &GetProgramUnitContaining(const Symbol &);
const Scope *FindModuleContaining(const Scope &);
+const Scope *FindModuleFileContaining(const Scope &);
const Scope *FindPureProcedureContaining(const Scope &);
const Scope *FindPureProcedureContaining(const Symbol &);
const Symbol *FindPointerComponent(const Scope &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 45bfde08dfb9..4bedbe8d1d8f 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -485,16 +485,17 @@ class CheckSpecificationExprHelper
template <typename T> Result operator()(const FunctionRef<T> &x) const {
if (const auto *symbol{x.proc().GetSymbol()}) {
- if (!semantics::IsPureProcedure(*symbol)) {
- return "reference to impure function '"s + symbol->name().ToString() +
+ const Symbol &ultimate{symbol->GetUltimate()};
+ if (!semantics::IsPureProcedure(ultimate)) {
+ return "reference to impure function '"s + ultimate.name().ToString() +
"'";
}
- if (semantics::IsStmtFunction(*symbol)) {
+ if (semantics::IsStmtFunction(ultimate)) {
return "reference to statement function '"s +
- symbol->name().ToString() + "'";
+ ultimate.name().ToString() + "'";
}
if (scope_.IsDerivedType()) { // C750, C754
- return "reference to function '"s + symbol->name().ToString() +
+ return "reference to function '"s + ultimate.name().ToString() +
"' not allowed for derived type components or type parameter"
" values";
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index a4961af71bbc..56a26d7e9bd8 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -165,7 +165,7 @@ class ArgumentAnalyzer {
}
void SayNoMatch(const std::string &, bool isAssignment = false);
std::string TypeAsFortran(std::size_t);
- bool AnyUntypedOperand();
+ bool AnyUntypedOrMissingOperand();
ExpressionAnalyzer &context_;
ActualArguments actuals_;
@@ -1943,7 +1943,8 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
*procedure, localActuals, GetFoldingContext())) {
if (CheckCompatibleArguments(*procedure, localActuals)) {
if (!procedure->IsElemental()) {
- return &specific; // takes priority over elemental match
+ // takes priority over elemental match
+ return &AccessSpecific(symbol, specific);
}
elemental = &specific;
}
@@ -1951,7 +1952,7 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
}
}
if (elemental) {
- return elemental;
+ return &AccessSpecific(symbol, *elemental);
}
// Check parent derived type
if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
@@ -1970,6 +1971,33 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
return nullptr;
}
+const Symbol &ExpressionAnalyzer::AccessSpecific(
+ const Symbol &originalGeneric, const Symbol &specific) {
+ if (const auto *hosted{
+ originalGeneric.detailsIf<semantics::HostAssocDetails>()}) {
+ return AccessSpecific(hosted->symbol(), specific);
+ } else if (const auto *used{
+ originalGeneric.detailsIf<semantics::UseDetails>()}) {
+ const auto &scope{originalGeneric.owner()};
+ auto iter{scope.find(specific.name())};
+ if (iter != scope.end() && iter->second->has<semantics::UseDetails>() &&
+ &iter->second->get<semantics::UseDetails>().symbol() == &specific) {
+ return specific;
+ } else {
+ // Create a renaming USE of the specific procedure.
+ auto rename{context_.SaveTempName(
+ used->symbol().owner().GetName().value().ToString() + "$" +
+ specific.name().ToString())};
+ return *const_cast<semantics::Scope &>(scope)
+ .try_emplace(rename, specific.attrs(),
+ semantics::UseDetails{rename, specific})
+ .first->second;
+ }
+ } else {
+ return specific;
+ }
+}
+
void ExpressionAnalyzer::EmitGenericResolutionError(const Symbol &symbol) {
if (semantics::IsGenericDefinedOp(symbol)) {
Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
@@ -2956,7 +2984,7 @@ bool ArgumentAnalyzer::CheckConformance() const {
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
const char *opr, parser::MessageFixedText &&error, bool isUserOp) {
- if (AnyUntypedOperand()) {
+ if (AnyUntypedOrMissingOperand()) {
context_.Say(
std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
return std::nullopt;
@@ -3271,7 +3299,9 @@ void ArgumentAnalyzer::SayNoMatch(const std::string &opr, bool isAssignment) {
}
std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) {
- if (std::optional<DynamicType> type{GetType(i)}) {
+ if (i >= actuals_.size() || !actuals_[i]) {
+ return "missing argument";
+ } else if (std::optional<DynamicType> type{GetType(i)}) {
return type->category() == TypeCategory::Derived
? "TYPE("s + type->AsFortran() + ')'
: type->category() == TypeCategory::Character
@@ -3282,9 +3312,9 @@ std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) {
}
}
-bool ArgumentAnalyzer::AnyUntypedOperand() {
+bool ArgumentAnalyzer::AnyUntypedOrMissingOperand() {
for (const auto &actual : actuals_) {
- if (!actual.value().GetType()) {
+ if (!actual || !actual->GetType()) {
return true;
}
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index cef4f0010302..5d9ee35b79b3 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2358,7 +2358,11 @@ ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
useModuleScope_->GetName().value());
return {};
}
- if (useSymbol->attrs().test(Attr::PRIVATE)) {
+ if (useSymbol->attrs().test(Attr::PRIVATE) &&
+ !FindModuleFileContaining(currScope())) {
+ // Privacy is not enforced in module files so that generic interfaces
+ // can be resolved to private specific procedures in specification
+ // expressions.
Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName),
useModuleScope_->GetName().value());
return {};
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index fb560aa84ffc..f299897603d9 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -325,16 +325,20 @@ SymbolVector SemanticsContext::GetIndexVars(IndexVarKind kind) {
return result;
}
+SourceName SemanticsContext::SaveTempName(std::string &&name) {
+ return {*tempNames_.emplace(std::move(name)).first};
+}
+
SourceName SemanticsContext::GetTempName(const Scope &scope) {
for (const auto &str : tempNames_) {
- SourceName name{str};
- if (scope.find(name) == scope.end()) {
- return name;
+ if (str.size() > 5 && str.substr(0, 5) == ".F18.") {
+ SourceName name{str};
+ if (scope.find(name) == scope.end()) {
+ return name;
+ }
}
}
- tempNames_.emplace_back(".F18.");
- tempNames_.back() += std::to_string(tempNames_.size());
- return {tempNames_.back()};
+ return SaveTempName(".F18."s + std::to_string(tempNames_.size()));
}
bool Semantics::Perform() {
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 81dde88ede5b..1bc008610bf0 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -52,6 +52,11 @@ const Scope *FindModuleContaining(const Scope &start) {
start, [](const Scope &scope) { return scope.IsModule(); });
}
+const Scope *FindModuleFileContaining(const Scope &start) {
+ return FindScopeContaining(
+ start, [](const Scope &scope) { return scope.IsModuleFile(); });
+}
+
const Scope &GetProgramUnitContaining(const Scope &start) {
CHECK(!start.IsGlobal());
return DEREF(FindScopeContaining(start, [](const Scope &scope) {
@@ -960,7 +965,12 @@ std::optional<parser::MessageFormattedText> CheckAccessibleComponent(
const Scope &scope, const Symbol &symbol) {
CHECK(symbol.owner().IsDerivedType()); // symbol must be a component
if (symbol.attrs().test(Attr::PRIVATE)) {
- if (const Scope * moduleScope{FindModuleContaining(symbol.owner())}) {
+ 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 component '%s' is only accessible within module '%s'"_err_en_US,
diff --git a/flang/test/Semantics/modfile39.f90 b/flang/test/Semantics/modfile39.f90
new file mode 100644
index 000000000000..f9d75705e01f
--- /dev/null
+++ b/flang/test/Semantics/modfile39.f90
@@ -0,0 +1,48 @@
+! RUN: %S/test_modfile.sh %s %t %f18
+! Resolution of specification expression references to generic interfaces
+! that resolve to private specific functions.
+
+module m1
+ interface gen
+ module procedure priv
+ end interface
+ private :: priv
+ contains
+ pure integer function priv(n)
+ integer, intent(in) :: n
+ priv = n
+ end function
+end module
+!Expect: m1.mod
+!module m1
+!interface gen
+!procedure::priv
+!end interface
+!private::priv
+!contains
+!pure function priv(n)
+!integer(4),intent(in)::n
+!integer(4)::priv
+!end
+!end
+
+module m2
+ use m1
+ contains
+ subroutine s(a)
+ real :: a(gen(1))
+ end subroutine
+end module
+!Expect: m2.mod
+!module m2
+!use m1,only:gen
+!use m1,only:m1$priv=>priv
+!private::m1$priv
+!contains
+!subroutine s(a)
+!real(4)::a(1_8:int(m1$priv(1_4),kind=8))
+!end
+!end
+
+use m2
+end
More information about the flang-commits
mailing list