[flang] Make proc characterization error conditional for generics #89429
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-fir-hlfir @llvm/pr-subscribers-flang-semantics Author: Peter Klausler (klausler) ChangesWhen 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 #88677. Full diff: https://github.com/llvm/llvm-project/pull/89429.diff 10 Files Affected:
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..ccbb19d9a324d6 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,14 @@ static std::optional<Procedure> CharacterizeProcedure(
return std::nullopt;
}
seenProcs.insert(symbol);
+ auto CheckForNested{[&](const Symbol &symbol) {
+ if (emitError) {
+ CHECK(!getenv("PMK"));
+ 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 +606,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 +649,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 +683,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 +703,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 +712,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 +759,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 +862,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 +997,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 +1011,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 +1023,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 +1370,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 +1406,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 +1418,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 29cdb3cff589ba..af0dd2aab91ee3 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
@@ -1543,7 +1543,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 ?
@@ -1672,7 +1672,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
+
|
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 llvm#88677.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
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 #88677.