[flang-commits] [flang] [flang] Make proc characterization error conditional for generics (PR #89429)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Apr 19 15:41:58 PDT 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/89429
>From 8c5f02e307e2abda8d2d05f541b0c17d48a2cd7c Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 19 Apr 2024 11:04:11 -0700
Subject: [PATCH] [flang] Make proc characterization error conditional for
generics
When the characteristics of a procedure depend on a procedure
that hasn't yet been defined, the compiler currently emits an
unconditional error message. This includes the case of a
procedure whose characteristics depend, perhaps indirectly, on
itself. However, in the case where the characteristics of a
procedure are needed to resolve a generic, we should not emit
an error for a hitherto undefined procedure -- either the call
will resolve to another specific procedure, in which case the
error is spurious, or it won't, and then an error will issue
anyway.
Fixes https://github.com/llvm/llvm-project/issues/88677.
---
.../include/flang/Evaluate/characteristics.h | 2 +-
flang/lib/Evaluate/characteristics.cpp | 74 ++++++++++---------
flang/lib/Evaluate/check-expression.cpp | 12 +--
flang/lib/Evaluate/tools.cpp | 4 +-
flang/lib/Lower/Bridge.cpp | 3 +-
flang/lib/Lower/CallInterface.cpp | 6 +-
flang/lib/Semantics/check-call.cpp | 4 +-
flang/lib/Semantics/expression.cpp | 5 +-
flang/lib/Semantics/pointer-assignment.cpp | 6 +-
flang/test/Semantics/resolve102.f90 | 13 ++++
10 files changed, 77 insertions(+), 52 deletions(-)
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 82c31c0c404301..8aa065b025a4fa 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -365,7 +365,7 @@ struct Procedure {
static std::optional<Procedure> Characterize(
const semantics::Symbol &, FoldingContext &);
static std::optional<Procedure> Characterize(
- const ProcedureDesignator &, FoldingContext &);
+ const ProcedureDesignator &, FoldingContext &, bool emitError);
static std::optional<Procedure> Characterize(
const ProcedureRef &, FoldingContext &);
static std::optional<Procedure> Characterize(
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 688a856220a117..20f7476425ace6 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -576,11 +576,11 @@ static std::optional<DummyArgument> CharacterizeDummyArgument(
semantics::UnorderedSymbolSet seenProcs);
static std::optional<FunctionResult> CharacterizeFunctionResult(
const semantics::Symbol &symbol, FoldingContext &context,
- semantics::UnorderedSymbolSet seenProcs);
+ semantics::UnorderedSymbolSet seenProcs, bool emitError);
static std::optional<Procedure> CharacterizeProcedure(
const semantics::Symbol &original, FoldingContext &context,
- semantics::UnorderedSymbolSet seenProcs) {
+ semantics::UnorderedSymbolSet seenProcs, bool emitError) {
const auto &symbol{ResolveAssociations(original)};
if (seenProcs.find(symbol) != seenProcs.end()) {
std::string procsList{GetSeenProcs(seenProcs)};
@@ -591,6 +591,13 @@ static std::optional<Procedure> CharacterizeProcedure(
return std::nullopt;
}
seenProcs.insert(symbol);
+ auto CheckForNested{[&](const Symbol &symbol) {
+ if (emitError) {
+ context.messages().Say(
+ "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
+ symbol.name());
+ }
+ }};
auto result{common::visit(
common::visitors{
[&](const semantics::SubprogramDetails &subp)
@@ -598,7 +605,7 @@ static std::optional<Procedure> CharacterizeProcedure(
Procedure result;
if (subp.isFunction()) {
if (auto fr{CharacterizeFunctionResult(
- subp.result(), context, seenProcs)}) {
+ subp.result(), context, seenProcs, emitError)}) {
result.functionResult = std::move(fr);
} else {
return std::nullopt;
@@ -641,8 +648,8 @@ static std::optional<Procedure> CharacterizeProcedure(
}
if (const semantics::Symbol *
interfaceSymbol{proc.procInterface()}) {
- auto result{
- CharacterizeProcedure(*interfaceSymbol, context, seenProcs)};
+ auto result{CharacterizeProcedure(
+ *interfaceSymbol, context, seenProcs, /*emitError=*/false)};
if (result && (IsDummy(symbol) || IsPointer(symbol))) {
// Dummy procedures and procedure pointers may not be
// ELEMENTAL, but we do accept the use of elemental intrinsic
@@ -675,8 +682,8 @@ static std::optional<Procedure> CharacterizeProcedure(
}
},
[&](const semantics::ProcBindingDetails &binding) {
- if (auto result{CharacterizeProcedure(
- binding.symbol(), context, seenProcs)}) {
+ if (auto result{CharacterizeProcedure(binding.symbol(), context,
+ seenProcs, /*emitError=*/false)}) {
if (binding.symbol().attrs().test(semantics::Attr::INTRINSIC)) {
result->attrs.reset(Procedure::Attr::Elemental);
}
@@ -695,7 +702,8 @@ static std::optional<Procedure> CharacterizeProcedure(
}
},
[&](const semantics::UseDetails &use) {
- return CharacterizeProcedure(use.symbol(), context, seenProcs);
+ return CharacterizeProcedure(
+ use.symbol(), context, seenProcs, /*emitError=*/false);
},
[](const semantics::UseErrorDetails &) {
// Ambiguous use-association will be handled later during symbol
@@ -703,25 +711,23 @@ static std::optional<Procedure> CharacterizeProcedure(
return std::optional<Procedure>{};
},
[&](const semantics::HostAssocDetails &assoc) {
- return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
+ return CharacterizeProcedure(
+ assoc.symbol(), context, seenProcs, /*emitError=*/false);
},
[&](const semantics::GenericDetails &generic) {
if (const semantics::Symbol * specific{generic.specific()}) {
- return CharacterizeProcedure(*specific, context, seenProcs);
+ return CharacterizeProcedure(
+ *specific, context, seenProcs, emitError);
} else {
return std::optional<Procedure>{};
}
},
[&](const semantics::EntityDetails &) {
- context.messages().Say(
- "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
- symbol.name());
+ CheckForNested(symbol);
return std::optional<Procedure>{};
},
[&](const semantics::SubprogramNameDetails &) {
- context.messages().Say(
- "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
- symbol.name());
+ CheckForNested(symbol);
return std::optional<Procedure>{};
},
[&](const auto &) {
@@ -752,7 +758,8 @@ static std::optional<Procedure> CharacterizeProcedure(
static std::optional<DummyProcedure> CharacterizeDummyProcedure(
const semantics::Symbol &symbol, FoldingContext &context,
semantics::UnorderedSymbolSet seenProcs) {
- if (auto procedure{CharacterizeProcedure(symbol, context, seenProcs)}) {
+ if (auto procedure{CharacterizeProcedure(
+ symbol, context, seenProcs, /*emitError=*/true)}) {
// Dummy procedures may not be elemental. Elemental dummy procedure
// interfaces are errors when the interface is not intrinsic, and that
// error is caught elsewhere. Elemental intrinsic interfaces are
@@ -854,7 +861,8 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
std::move(name), std::move(obj));
},
[&](const ProcedureDesignator &designator) {
- if (auto proc{Procedure::Characterize(designator, context)}) {
+ if (auto proc{Procedure::Characterize(
+ designator, context, /*emitError=*/true)}) {
return std::make_optional<DummyArgument>(
std::move(name), DummyProcedure{std::move(*proc)});
} else {
@@ -988,7 +996,7 @@ bool FunctionResult::operator==(const FunctionResult &that) const {
static std::optional<FunctionResult> CharacterizeFunctionResult(
const semantics::Symbol &symbol, FoldingContext &context,
- semantics::UnorderedSymbolSet seenProcs) {
+ semantics::UnorderedSymbolSet seenProcs, bool emitError) {
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
if (auto type{TypeAndShape::Characterize(
symbol, context, /*invariantOnly=*/false)}) {
@@ -1002,8 +1010,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
result.cudaDataAttr = object->cudaDataAttr();
return result;
}
- } else if (auto maybeProc{
- CharacterizeProcedure(symbol, context, seenProcs)}) {
+ } else if (auto maybeProc{CharacterizeProcedure(
+ symbol, context, seenProcs, emitError)}) {
FunctionResult result{std::move(*maybeProc)};
result.attrs.set(FunctionResult::Attr::Pointer);
return result;
@@ -1014,7 +1022,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
std::optional<FunctionResult> FunctionResult::Characterize(
const Symbol &symbol, FoldingContext &context) {
semantics::UnorderedSymbolSet seenProcs;
- return CharacterizeFunctionResult(symbol, context, seenProcs);
+ return CharacterizeFunctionResult(
+ symbol, context, seenProcs, /*emitError=*/false);
}
bool FunctionResult::IsAssumedLengthCharacter() const {
@@ -1360,27 +1369,26 @@ bool Procedure::CanOverride(
}
std::optional<Procedure> Procedure::Characterize(
- const semantics::Symbol &original, FoldingContext &context) {
+ const semantics::Symbol &symbol, FoldingContext &context) {
semantics::UnorderedSymbolSet seenProcs;
- return CharacterizeProcedure(original, context, seenProcs);
+ return CharacterizeProcedure(symbol, context, seenProcs, /*emitError=*/true);
}
std::optional<Procedure> Procedure::Characterize(
- const ProcedureDesignator &proc, FoldingContext &context) {
+ const ProcedureDesignator &proc, FoldingContext &context, bool emitError) {
if (const auto *symbol{proc.GetSymbol()}) {
- if (auto result{
- characteristics::Procedure::Characterize(*symbol, context)}) {
- return result;
- }
+ semantics::UnorderedSymbolSet seenProcs;
+ return CharacterizeProcedure(*symbol, context, seenProcs, emitError);
} else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {
return intrinsic->characteristics.value();
+ } else {
+ return std::nullopt;
}
- return std::nullopt;
}
std::optional<Procedure> Procedure::Characterize(
const ProcedureRef &ref, FoldingContext &context) {
- if (auto callee{Characterize(ref.proc(), context)}) {
+ if (auto callee{Characterize(ref.proc(), context, /*emitError=*/true)}) {
if (callee->functionResult) {
if (const Procedure *
proc{callee->functionResult->IsProcedurePointer()}) {
@@ -1397,7 +1405,7 @@ std::optional<Procedure> Procedure::Characterize(
return Characterize(*procRef, context);
} else if (const auto *procDesignator{
std::get_if<ProcedureDesignator>(&expr.u)}) {
- return Characterize(*procDesignator, context);
+ return Characterize(*procDesignator, context, /*emitError=*/true);
} else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
return Characterize(*symbol, context);
} else {
@@ -1409,7 +1417,7 @@ std::optional<Procedure> Procedure::Characterize(
std::optional<Procedure> Procedure::FromActuals(const ProcedureDesignator &proc,
const ActualArguments &args, FoldingContext &context) {
- auto callee{Characterize(proc, context)};
+ auto callee{Characterize(proc, context, /*emitError=*/true)};
if (callee) {
if (callee->dummyArguments.empty() &&
callee->attrs.test(Procedure::Attr::ImplicitInterface)) {
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 0e14aa0957294c..7e42db7b6ed7ab 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -666,8 +666,8 @@ class CheckSpecificationExprHelper
"' not allowed for derived type components or type parameter"
" values";
}
- if (auto procChars{
- characteristics::Procedure::Characterize(x.proc(), context_)}) {
+ if (auto procChars{characteristics::Procedure::Characterize(
+ x.proc(), context_, /*emitError=*/true)}) {
const auto iter{std::find_if(procChars->dummyArguments.begin(),
procChars->dummyArguments.end(),
[](const characteristics::DummyArgument &dummy) {
@@ -856,8 +856,8 @@ class IsContiguousHelper
Result operator()(const Substring &) const { return std::nullopt; }
Result operator()(const ProcedureRef &x) const {
- if (auto chars{
- characteristics::Procedure::Characterize(x.proc(), context_)}) {
+ if (auto chars{characteristics::Procedure::Characterize(
+ x.proc(), context_, /*emitError=*/true)}) {
if (chars->functionResult) {
const auto &result{*chars->functionResult};
if (!result.IsProcedurePointer()) {
@@ -1103,8 +1103,8 @@ class StmtFunctionChecker
}
}
}
- if (auto chars{
- characteristics::Procedure::Characterize(proc, context_)}) {
+ if (auto chars{characteristics::Procedure::Characterize(
+ proc, context_, /*emitError=*/true)}) {
if (!chars->CanBeCalledViaImplicitInterface()) {
if (severity_) {
auto msg{
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index f514a25b010241..9a5f9130632ee8 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1056,8 +1056,8 @@ class FindImpureCallHelper
explicit FindImpureCallHelper(FoldingContext &c) : Base{*this}, context_{c} {}
using Base::operator();
Result operator()(const ProcedureRef &call) const {
- if (auto chars{
- characteristics::Procedure::Characterize(call.proc(), context_)}) {
+ if (auto chars{characteristics::Procedure::Characterize(
+ call.proc(), context_, /*emitError=*/false)}) {
if (chars->attrs.test(characteristics::Procedure::Attr::Pure)) {
return (*this)(call.arguments());
}
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 47bd6ace4e4b56..8b62fe8c022f80 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3700,7 +3700,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
using DummyAttr = Fortran::evaluate::characteristics::DummyDataObject::Attr;
if (auto procedure =
Fortran::evaluate::characteristics::Procedure::Characterize(
- userDefinedAssignment.proc(), getFoldingContext()))
+ userDefinedAssignment.proc(), getFoldingContext(),
+ /*emitError=*/false))
if (!procedure->dummyArguments.empty())
if (const auto *dataArg = std::get_if<
Fortran::evaluate::characteristics::DummyDataObject>(
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 2d4d17a2ef12e9..5ad244600328ca 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -218,7 +218,7 @@ Fortran::lower::CallerInterface::characterize() const {
converter.getFoldingContext();
std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
Fortran::evaluate::characteristics::Procedure::Characterize(
- procRef.proc(), foldingContext);
+ procRef.proc(), foldingContext, /*emitError=*/false);
assert(characteristic && "Failed to get characteristic from procRef");
// The characteristic may not contain the argument characteristic if the
// ProcedureDesignator has no interface, or may mismatch in case of implicit
@@ -1571,7 +1571,7 @@ class SignatureBuilder
Fortran::lower::AbstractConverter &c)
: CallInterface{c}, procDesignator{&procDes},
proc{Fortran::evaluate::characteristics::Procedure::Characterize(
- procDes, converter.getFoldingContext())
+ procDes, converter.getFoldingContext(), /*emitError=*/false)
.value()} {}
/// Does the procedure characteristics being translated have alternate
/// returns ?
@@ -1696,7 +1696,7 @@ bool Fortran::lower::mustPassLengthWithDummyProcedure(
Fortran::lower::AbstractConverter &converter) {
std::optional<Fortran::evaluate::characteristics::Procedure> characteristics =
Fortran::evaluate::characteristics::Procedure::Characterize(
- procedure, converter.getFoldingContext());
+ procedure, converter.getFoldingContext(), /*emitError=*/false);
return ::mustPassLengthWithDummyProcedure(characteristics);
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index bd2f755855172a..6cbc3565dc3775 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1597,8 +1597,8 @@ static void CheckReduce(
if (const auto *expr{operation->UnwrapExpr()}) {
if (const auto *designator{
std::get_if<evaluate::ProcedureDesignator>(&expr->u)}) {
- procChars =
- characteristics::Procedure::Characterize(*designator, context);
+ procChars = characteristics::Procedure::Characterize(
+ *designator, context, /*emitError=*/true);
} else if (const auto *ref{
std::get_if<evaluate::ProcedureRef>(&expr->u)}) {
procChars = characteristics::Procedure::Characterize(*ref, context);
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 6af86de9dd81cb..a270e4b385e8db 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2562,7 +2562,8 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
}
if (std::optional<characteristics::Procedure> procedure{
characteristics::Procedure::Characterize(
- ProcedureDesignator{specific}, context_.foldingContext())}) {
+ ProcedureDesignator{specific}, context_.foldingContext(),
+ /*emitError=*/false)}) {
ActualArguments localActuals{actuals};
if (specific.has<semantics::ProcBindingDetails>()) {
if (!adjustActuals.value()(specific, localActuals)) {
@@ -3164,7 +3165,7 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
}
if (!chars) {
chars = characteristics::Procedure::Characterize(
- proc, context_.foldingContext());
+ proc, context_.foldingContext(), /*emitError=*/true);
}
bool ok{true};
if (chars) {
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 4b4ce153084d8e..60a496a63cb380 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -244,7 +244,8 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
} else if (const auto *intrinsic{f.proc().GetSpecificIntrinsic()}) {
funcName = intrinsic->name;
}
- auto proc{Procedure::Characterize(f.proc(), foldingContext_)};
+ auto proc{
+ Procedure::Characterize(f.proc(), foldingContext_, /*emitError=*/true)};
if (!proc) {
return false;
}
@@ -393,7 +394,8 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
symbol->name());
}
}
- if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
+ if (auto chars{
+ Procedure::Characterize(d, foldingContext_, /*emitError=*/true)}) {
// Disregard the elemental attribute of RHS intrinsics.
if (symbol && symbol->GetUltimate().attrs().test(Attr::INTRINSIC)) {
chars->attrs.reset(Procedure::Attr::Elemental);
diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90
index 11f2ce9c8ea561..8f6e2246a57e79 100644
--- a/flang/test/Semantics/resolve102.f90
+++ b/flang/test/Semantics/resolve102.f90
@@ -106,3 +106,16 @@ pure integer function g(n)
g = size(arr)
end function
end
+
+module genericInSpec
+ interface int
+ procedure ifunc
+ end interface
+ contains
+ function ifunc(x)
+ integer a(int(kind(1))) ! generic is ok with most compilers
+ integer(size(a)), intent(in) :: x
+ ifunc = x
+ end
+end
+
More information about the flang-commits
mailing list