[flang-commits] [flang] 3cc5d4f - [flang] Fix generic/specific procedure confusion
peter klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jun 25 11:54:43 PDT 2021
Author: peter klausler
Date: 2021-06-25T11:54:29-07:00
New Revision: 3cc5d4ff8e4e59cc45f370655c7762e36b223d1d
URL: https://github.com/llvm/llvm-project/commit/3cc5d4ff8e4e59cc45f370655c7762e36b223d1d
DIFF: https://github.com/llvm/llvm-project/commit/3cc5d4ff8e4e59cc45f370655c7762e36b223d1d.diff
LOG: [flang] Fix generic/specific procedure confusion
A recent change that extended semantic analysis for actual arguments
that associate with procedure dummy arguments exposed some bugs in
regression test suites due to points of confusion in symbol table
handling in situations where a generic interface contains a specific
procedure of the same name. When passing that name as an actual
argument, for example, it's necessary to take this possibility into
account because the symbol for the generic interface shadows the
symbol of the same name for the specific procedure, which is
what needs to be checked. So add a small utility that bypasses
the symbol for a generic interface in this case, and use it
where needed.
Differential Revision: https://reviews.llvm.org/D104929
Added:
Modified:
flang/include/flang/Parser/parse-tree.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/fold-reduction.h
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/runtime/type-info.h
Removed:
################################################################################
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 1fbe1160324ae..5ce6a110c1e65 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1779,7 +1779,7 @@ struct Designator {
struct Variable {
UNION_CLASS_BOILERPLATE(Variable);
mutable TypedExpr typedExpr;
- parser::CharBlock GetSource() const;
+ CharBlock GetSource() const;
std::variant<common::Indirection<Designator>,
common::Indirection<FunctionReference>>
u;
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index aa48c7456aeb6..776594ed23fc4 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -252,6 +252,10 @@ const Symbol *FindExternallyVisibleObject(
expr.u);
}
+// Apply GetUltimate(), then if the symbol is a generic procedure shadowing a
+// specific procedure of the same name, return it instead.
+const Symbol &BypassGeneric(const Symbol &);
+
using SomeExpr = evaluate::Expr<evaluate::SomeType>;
bool ExprHasTypeCategory(
diff --git a/flang/lib/Evaluate/fold-reduction.h b/flang/lib/Evaluate/fold-reduction.h
index 8793b00912925..4b265ecf4716a 100644
--- a/flang/lib/Evaluate/fold-reduction.h
+++ b/flang/lib/Evaluate/fold-reduction.h
@@ -139,7 +139,7 @@ static Expr<T> FoldMaxvalMinval(FoldingContext &context, FunctionRef<T> &&ref,
static_assert(T::category == TypeCategory::Integer ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Character);
- using Element = Scalar<T>; // pmk: was typename Constant<T>::Element;
+ using Element = Scalar<T>;
std::optional<ConstantSubscript> dim;
if (std::optional<Constant<T>> array{
ProcessReductionArgs<T>(context, ref.arguments(), dim, identity,
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 95943b3837bc4..f6e55263820de 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -175,14 +175,18 @@ class ArgumentAnalyzer {
// or procedure pointer reference in a ProcedureDesignator.
MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
const Symbol &last{ref.GetLastSymbol()};
- const Symbol &symbol{last.GetUltimate()};
+ const Symbol &symbol{BypassGeneric(last).GetUltimate()};
if (semantics::IsProcedure(symbol)) {
if (auto *component{std::get_if<Component>(&ref.u)}) {
return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
} else if (!std::holds_alternative<SymbolRef>(ref.u)) {
DIE("unexpected alternative in DataRef");
} else if (!symbol.attrs().test(semantics::Attr::INTRINSIC)) {
- return Expr<SomeType>{ProcedureDesignator{symbol}};
+ if (symbol.has<semantics::GenericDetails>()) {
+ Say("'%s' is not a specific procedure"_err_en_US, symbol.name());
+ } else {
+ return Expr<SomeType>{ProcedureDesignator{symbol}};
+ }
} else if (auto interface{context_.intrinsics().IsSpecificIntrinsicFunction(
symbol.name().ToString())}) {
SpecificIntrinsic intrinsic{
@@ -3117,8 +3121,6 @@ void ArgumentAnalyzer::Analyze(
std::optional<ActualArgument> actual;
std::visit(common::visitors{
[&](const common::Indirection<parser::Expr> &x) {
- // TODO: Distinguish & handle procedure name and
- // proc-component-ref
actual = AnalyzeExpr(x.value());
},
[&](const parser::AltReturnSpec &label) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5ab4d39590d9c..e3baae275aa1a 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2751,7 +2751,7 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
auto &details{generic.get<GenericDetails>()};
UnorderedSymbolSet symbolsSeen;
for (const Symbol &symbol : details.specificProcs()) {
- symbolsSeen.insert(symbol);
+ symbolsSeen.insert(symbol.GetUltimate());
}
auto range{specificProcs_.equal_range(&generic)};
for (auto it{range.first}; it != range.second; ++it) {
@@ -2762,12 +2762,8 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
Say(*name, "Procedure '%s' not found"_err_en_US);
continue;
}
- if (symbol == &generic) {
- if (auto *specific{generic.get<GenericDetails>().specific()}) {
- symbol = specific;
- }
- }
- const Symbol &ultimate{symbol->GetUltimate()};
+ const Symbol &specific{BypassGeneric(*symbol)};
+ const Symbol &ultimate{specific.GetUltimate()};
if (!ultimate.has<SubprogramDetails>() &&
!ultimate.has<SubprogramNameDetails>()) {
Say(*name, "'%s' is not a subprogram"_err_en_US);
@@ -2788,20 +2784,21 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
}
}
}
- if (!symbolsSeen.insert(ultimate).second) {
- if (symbol == &ultimate) {
- Say(name->source,
- "Procedure '%s' is already specified in generic '%s'"_err_en_US,
- name->source, MakeOpName(generic.name()));
- } else {
- Say(name->source,
- "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
- ultimate.name(), ultimate.owner().GetName().value(),
- MakeOpName(generic.name()));
- }
- continue;
+ if (symbolsSeen.insert(ultimate).second /*true if added*/) {
+ // When a specific procedure is a USE association, that association
+ // is saved in the generic's specifics, not its ultimate symbol,
+ // so that module file output of interfaces can distinguish them.
+ details.AddSpecificProc(specific, name->source);
+ } else if (&specific == &ultimate) {
+ Say(name->source,
+ "Procedure '%s' is already specified in generic '%s'"_err_en_US,
+ name->source, MakeOpName(generic.name()));
+ } else {
+ Say(name->source,
+ "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
+ ultimate.name(), ultimate.owner().GetName().value(),
+ MakeOpName(generic.name()));
}
- details.AddSpecificProc(*symbol, name->source);
}
specificProcs_.erase(range.first, range.second);
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 6440175c502d1..e84629b063b86 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -359,6 +359,16 @@ const Symbol *FindExternallyVisibleObject(
return nullptr;
}
+const Symbol &BypassGeneric(const Symbol &symbol) {
+ const Symbol &ultimate{symbol.GetUltimate()};
+ if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
+ if (const Symbol * specific{generic->specific()}) {
+ return *specific;
+ }
+ }
+ return symbol;
+}
+
bool ExprHasTypeCategory(
const SomeExpr &expr, const common::TypeCategory &type) {
auto dynamicType{expr.GetType()};
diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h
index 78159c9bcd10a..05a4c41a34997 100644
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -82,8 +82,7 @@ class DerivedType {
lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
// This array of local data components includes the parent component.
- // Components are in alphabetic order.
- // TODO pmk: fix to be "component order"
+ // Components are in component order, not collation order of their names.
// It does not include procedure pointer components.
StaticDescriptor<1, true>
component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
More information about the flang-commits
mailing list