Skip to content

Commit cb26391

Browse files
klauslerklausler
authored
[flang] Make proc characterization error conditional for generics (#89429)
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.
1 parent d2be982 commit cb26391

File tree

10 files changed

+77
-52
lines changed

10 files changed

+77
-52
lines changed

‎flang/include/flang/Evaluate/characteristics.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -365,7 +365,7 @@ struct Procedure {
365365
static std::optional<Procedure> Characterize(
366366
const semantics::Symbol &, FoldingContext &);
367367
static std::optional<Procedure> Characterize(
368-
const ProcedureDesignator &, FoldingContext &);
368+
const ProcedureDesignator &, FoldingContext &, bool emitError);
369369
static std::optional<Procedure> Characterize(
370370
const ProcedureRef &, FoldingContext &);
371371
static std::optional<Procedure> Characterize(

‎flang/lib/Evaluate/characteristics.cpp‎

Lines changed: 41 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -576,11 +576,11 @@ static std::optional<DummyArgument> CharacterizeDummyArgument(
576576
semantics::UnorderedSymbolSet seenProcs);
577577
static std::optional<FunctionResult> CharacterizeFunctionResult(
578578
const semantics::Symbol &symbol, FoldingContext &context,
579-
semantics::UnorderedSymbolSet seenProcs);
579+
semantics::UnorderedSymbolSet seenProcs, bool emitError);
580580

581581
static std::optional<Procedure> CharacterizeProcedure(
582582
const semantics::Symbol &original, FoldingContext &context,
583-
semantics::UnorderedSymbolSet seenProcs) {
583+
semantics::UnorderedSymbolSet seenProcs, bool emitError) {
584584
const auto &symbol{ResolveAssociations(original)};
585585
if (seenProcs.find(symbol) != seenProcs.end()) {
586586
std::string procsList{GetSeenProcs(seenProcs)};
@@ -591,14 +591,21 @@ static std::optional<Procedure> CharacterizeProcedure(
591591
return std::nullopt;
592592
}
593593
seenProcs.insert(symbol);
594+
auto CheckForNested{[&](const Symbol &symbol) {
595+
if (emitError) {
596+
context.messages().Say(
597+
"Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
598+
symbol.name());
599+
}
600+
}};
594601
auto result{common::visit(
595602
common::visitors{
596603
[&](const semantics::SubprogramDetails &subp)
597604
-> std::optional<Procedure> {
598605
Procedure result;
599606
if (subp.isFunction()) {
600607
if (auto fr{CharacterizeFunctionResult(
601-
subp.result(), context, seenProcs)}) {
608+
subp.result(), context, seenProcs, emitError)}) {
602609
result.functionResult = std::move(fr);
603610
} else {
604611
return std::nullopt;
@@ -641,8 +648,8 @@ static std::optional<Procedure> CharacterizeProcedure(
641648
}
642649
if (const semantics::Symbol *
643650
interfaceSymbol{proc.procInterface()}) {
644-
auto result{
645-
CharacterizeProcedure(*interfaceSymbol, context, seenProcs)};
651+
auto result{CharacterizeProcedure(
652+
*interfaceSymbol, context, seenProcs, /*emitError=*/false)};
646653
if (result && (IsDummy(symbol) || IsPointer(symbol))) {
647654
// Dummy procedures and procedure pointers may not be
648655
// ELEMENTAL, but we do accept the use of elemental intrinsic
@@ -675,8 +682,8 @@ static std::optional<Procedure> CharacterizeProcedure(
675682
}
676683
},
677684
[&](const semantics::ProcBindingDetails &binding) {
678-
if (auto result{CharacterizeProcedure(
679-
binding.symbol(), context, seenProcs)}) {
685+
if (auto result{CharacterizeProcedure(binding.symbol(), context,
686+
seenProcs, /*emitError=*/false)}) {
680687
if (binding.symbol().attrs().test(semantics::Attr::INTRINSIC)) {
681688
result->attrs.reset(Procedure::Attr::Elemental);
682689
}
@@ -695,33 +702,32 @@ static std::optional<Procedure> CharacterizeProcedure(
695702
}
696703
},
697704
[&](const semantics::UseDetails &use) {
698-
return CharacterizeProcedure(use.symbol(), context, seenProcs);
705+
return CharacterizeProcedure(
706+
use.symbol(), context, seenProcs, /*emitError=*/false);
699707
},
700708
[](const semantics::UseErrorDetails &) {
701709
// Ambiguous use-association will be handled later during symbol
702710
// checks, ignore UseErrorDetails here without actual symbol usage.
703711
return std::optional<Procedure>{};
704712
},
705713
[&](const semantics::HostAssocDetails &assoc) {
706-
return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
714+
return CharacterizeProcedure(
715+
assoc.symbol(), context, seenProcs, /*emitError=*/false);
707716
},
708717
[&](const semantics::GenericDetails &generic) {
709718
if (const semantics::Symbol * specific{generic.specific()}) {
710-
return CharacterizeProcedure(*specific, context, seenProcs);
719+
return CharacterizeProcedure(
720+
*specific, context, seenProcs, emitError);
711721
} else {
712722
return std::optional<Procedure>{};
713723
}
714724
},
715725
[&](const semantics::EntityDetails &) {
716-
context.messages().Say(
717-
"Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
718-
symbol.name());
726+
CheckForNested(symbol);
719727
return std::optional<Procedure>{};
720728
},
721729
[&](const semantics::SubprogramNameDetails &) {
722-
context.messages().Say(
723-
"Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
724-
symbol.name());
730+
CheckForNested(symbol);
725731
return std::optional<Procedure>{};
726732
},
727733
[&](const auto &) {
@@ -752,7 +758,8 @@ static std::optional<Procedure> CharacterizeProcedure(
752758
static std::optional<DummyProcedure> CharacterizeDummyProcedure(
753759
const semantics::Symbol &symbol, FoldingContext &context,
754760
semantics::UnorderedSymbolSet seenProcs) {
755-
if (auto procedure{CharacterizeProcedure(symbol, context, seenProcs)}) {
761+
if (auto procedure{CharacterizeProcedure(
762+
symbol, context, seenProcs, /*emitError=*/true)}) {
756763
// Dummy procedures may not be elemental. Elemental dummy procedure
757764
// interfaces are errors when the interface is not intrinsic, and that
758765
// error is caught elsewhere. Elemental intrinsic interfaces are
@@ -854,7 +861,8 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
854861
std::move(name), std::move(obj));
855862
},
856863
[&](const ProcedureDesignator &designator) {
857-
if (auto proc{Procedure::Characterize(designator, context)}) {
864+
if (auto proc{Procedure::Characterize(
865+
designator, context, /*emitError=*/true)}) {
858866
return std::make_optional<DummyArgument>(
859867
std::move(name), DummyProcedure{std::move(*proc)});
860868
} else {
@@ -988,7 +996,7 @@ bool FunctionResult::operator==(const FunctionResult &that) const {
988996

989997
static std::optional<FunctionResult> CharacterizeFunctionResult(
990998
const semantics::Symbol &symbol, FoldingContext &context,
991-
semantics::UnorderedSymbolSet seenProcs) {
999+
semantics::UnorderedSymbolSet seenProcs, bool emitError) {
9921000
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
9931001
if (auto type{TypeAndShape::Characterize(
9941002
symbol, context, /*invariantOnly=*/false)}) {
@@ -1002,8 +1010,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
10021010
result.cudaDataAttr = object->cudaDataAttr();
10031011
return result;
10041012
}
1005-
} else if (auto maybeProc{
1006-
CharacterizeProcedure(symbol, context, seenProcs)}) {
1013+
} else if (auto maybeProc{CharacterizeProcedure(
1014+
symbol, context, seenProcs, emitError)}) {
10071015
FunctionResult result{std::move(*maybeProc)};
10081016
result.attrs.set(FunctionResult::Attr::Pointer);
10091017
return result;
@@ -1014,7 +1022,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
10141022
std::optional<FunctionResult> FunctionResult::Characterize(
10151023
const Symbol &symbol, FoldingContext &context) {
10161024
semantics::UnorderedSymbolSet seenProcs;
1017-
return CharacterizeFunctionResult(symbol, context, seenProcs);
1025+
return CharacterizeFunctionResult(
1026+
symbol, context, seenProcs, /*emitError=*/false);
10181027
}
10191028

10201029
bool FunctionResult::IsAssumedLengthCharacter() const {
@@ -1360,27 +1369,26 @@ bool Procedure::CanOverride(
13601369
}
13611370

13621371
std::optional<Procedure> Procedure::Characterize(
1363-
const semantics::Symbol &original, FoldingContext &context) {
1372+
const semantics::Symbol &symbol, FoldingContext &context) {
13641373
semantics::UnorderedSymbolSet seenProcs;
1365-
return CharacterizeProcedure(original, context, seenProcs);
1374+
return CharacterizeProcedure(symbol, context, seenProcs, /*emitError=*/true);
13661375
}
13671376

13681377
std::optional<Procedure> Procedure::Characterize(
1369-
const ProcedureDesignator &proc, FoldingContext &context) {
1378+
const ProcedureDesignator &proc, FoldingContext &context, bool emitError) {
13701379
if (const auto *symbol{proc.GetSymbol()}) {
1371-
if (auto result{
1372-
characteristics::Procedure::Characterize(*symbol, context)}) {
1373-
return result;
1374-
}
1380+
semantics::UnorderedSymbolSet seenProcs;
1381+
return CharacterizeProcedure(*symbol, context, seenProcs, emitError);
13751382
} else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {
13761383
return intrinsic->characteristics.value();
1384+
} else {
1385+
return std::nullopt;
13771386
}
1378-
return std::nullopt;
13791387
}
13801388

13811389
std::optional<Procedure> Procedure::Characterize(
13821390
const ProcedureRef &ref, FoldingContext &context) {
1383-
if (auto callee{Characterize(ref.proc(), context)}) {
1391+
if (auto callee{Characterize(ref.proc(), context, /*emitError=*/true)}) {
13841392
if (callee->functionResult) {
13851393
if (const Procedure *
13861394
proc{callee->functionResult->IsProcedurePointer()}) {
@@ -1397,7 +1405,7 @@ std::optional<Procedure> Procedure::Characterize(
13971405
return Characterize(*procRef, context);
13981406
} else if (const auto *procDesignator{
13991407
std::get_if<ProcedureDesignator>(&expr.u)}) {
1400-
return Characterize(*procDesignator, context);
1408+
return Characterize(*procDesignator, context, /*emitError=*/true);
14011409
} else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
14021410
return Characterize(*symbol, context);
14031411
} else {
@@ -1409,7 +1417,7 @@ std::optional<Procedure> Procedure::Characterize(
14091417

14101418
std::optional<Procedure> Procedure::FromActuals(const ProcedureDesignator &proc,
14111419
const ActualArguments &args, FoldingContext &context) {
1412-
auto callee{Characterize(proc, context)};
1420+
auto callee{Characterize(proc, context, /*emitError=*/true)};
14131421
if (callee) {
14141422
if (callee->dummyArguments.empty() &&
14151423
callee->attrs.test(Procedure::Attr::ImplicitInterface)) {

‎flang/lib/Evaluate/check-expression.cpp‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -666,8 +666,8 @@ class CheckSpecificationExprHelper
666666
"' not allowed for derived type components or type parameter"
667667
" values";
668668
}
669-
if (auto procChars{
670-
characteristics::Procedure::Characterize(x.proc(), context_)}) {
669+
if (auto procChars{characteristics::Procedure::Characterize(
670+
x.proc(), context_, /*emitError=*/true)}) {
671671
const auto iter{std::find_if(procChars->dummyArguments.begin(),
672672
procChars->dummyArguments.end(),
673673
[](const characteristics::DummyArgument &dummy) {
@@ -856,8 +856,8 @@ class IsContiguousHelper
856856
Result operator()(const Substring &) const { return std::nullopt; }
857857

858858
Result operator()(const ProcedureRef &x) const {
859-
if (auto chars{
860-
characteristics::Procedure::Characterize(x.proc(), context_)}) {
859+
if (auto chars{characteristics::Procedure::Characterize(
860+
x.proc(), context_, /*emitError=*/true)}) {
861861
if (chars->functionResult) {
862862
const auto &result{*chars->functionResult};
863863
if (!result.IsProcedurePointer()) {
@@ -1103,8 +1103,8 @@ class StmtFunctionChecker
11031103
}
11041104
}
11051105
}
1106-
if (auto chars{
1107-
characteristics::Procedure::Characterize(proc, context_)}) {
1106+
if (auto chars{characteristics::Procedure::Characterize(
1107+
proc, context_, /*emitError=*/true)}) {
11081108
if (!chars->CanBeCalledViaImplicitInterface()) {
11091109
if (severity_) {
11101110
auto msg{

‎flang/lib/Evaluate/tools.cpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1056,8 +1056,8 @@ class FindImpureCallHelper
10561056
explicit FindImpureCallHelper(FoldingContext &c) : Base{*this}, context_{c} {}
10571057
using Base::operator();
10581058
Result operator()(const ProcedureRef &call) const {
1059-
if (auto chars{
1060-
characteristics::Procedure::Characterize(call.proc(), context_)}) {
1059+
if (auto chars{characteristics::Procedure::Characterize(
1060+
call.proc(), context_, /*emitError=*/false)}) {
10611061
if (chars->attrs.test(characteristics::Procedure::Attr::Pure)) {
10621062
return (*this)(call.arguments());
10631063
}

‎flang/lib/Lower/Bridge.cpp‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3700,7 +3700,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
37003700
using DummyAttr = Fortran::evaluate::characteristics::DummyDataObject::Attr;
37013701
if (auto procedure =
37023702
Fortran::evaluate::characteristics::Procedure::Characterize(
3703-
userDefinedAssignment.proc(), getFoldingContext()))
3703+
userDefinedAssignment.proc(), getFoldingContext(),
3704+
/*emitError=*/false))
37043705
if (!procedure->dummyArguments.empty())
37053706
if (const auto *dataArg = std::get_if<
37063707
Fortran::evaluate::characteristics::DummyDataObject>(

‎flang/lib/Lower/CallInterface.cpp‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -218,7 +218,7 @@ Fortran::lower::CallerInterface::characterize() const {
218218
converter.getFoldingContext();
219219
std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
220220
Fortran::evaluate::characteristics::Procedure::Characterize(
221-
procRef.proc(), foldingContext);
221+
procRef.proc(), foldingContext, /*emitError=*/false);
222222
assert(characteristic && "Failed to get characteristic from procRef");
223223
// The characteristic may not contain the argument characteristic if the
224224
// ProcedureDesignator has no interface, or may mismatch in case of implicit
@@ -1571,7 +1571,7 @@ class SignatureBuilder
15711571
Fortran::lower::AbstractConverter &c)
15721572
: CallInterface{c}, procDesignator{&procDes},
15731573
proc{Fortran::evaluate::characteristics::Procedure::Characterize(
1574-
procDes, converter.getFoldingContext())
1574+
procDes, converter.getFoldingContext(), /*emitError=*/false)
15751575
.value()} {}
15761576
/// Does the procedure characteristics being translated have alternate
15771577
/// returns ?
@@ -1696,7 +1696,7 @@ bool Fortran::lower::mustPassLengthWithDummyProcedure(
16961696
Fortran::lower::AbstractConverter &converter) {
16971697
std::optional<Fortran::evaluate::characteristics::Procedure> characteristics =
16981698
Fortran::evaluate::characteristics::Procedure::Characterize(
1699-
procedure, converter.getFoldingContext());
1699+
procedure, converter.getFoldingContext(), /*emitError=*/false);
17001700
return ::mustPassLengthWithDummyProcedure(characteristics);
17011701
}
17021702

‎flang/lib/Semantics/check-call.cpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1602,8 +1602,8 @@ static void CheckReduce(
16021602
if (const auto *expr{operation->UnwrapExpr()}) {
16031603
if (const auto *designator{
16041604
std::get_if<evaluate::ProcedureDesignator>(&expr->u)}) {
1605-
procChars =
1606-
characteristics::Procedure::Characterize(*designator, context);
1605+
procChars = characteristics::Procedure::Characterize(
1606+
*designator, context, /*emitError=*/true);
16071607
} else if (const auto *ref{
16081608
std::get_if<evaluate::ProcedureRef>(&expr->u)}) {
16091609
procChars = characteristics::Procedure::Characterize(*ref, context);

‎flang/lib/Semantics/expression.cpp‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2562,7 +2562,8 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
25622562
}
25632563
if (std::optional<characteristics::Procedure> procedure{
25642564
characteristics::Procedure::Characterize(
2565-
ProcedureDesignator{specific}, context_.foldingContext())}) {
2565+
ProcedureDesignator{specific}, context_.foldingContext(),
2566+
/*emitError=*/false)}) {
25662567
ActualArguments localActuals{actuals};
25672568
if (specific.has<semantics::ProcBindingDetails>()) {
25682569
if (!adjustActuals.value()(specific, localActuals)) {
@@ -3164,7 +3165,7 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
31643165
}
31653166
if (!chars) {
31663167
chars = characteristics::Procedure::Characterize(
3167-
proc, context_.foldingContext());
3168+
proc, context_.foldingContext(), /*emitError=*/true);
31683169
}
31693170
bool ok{true};
31703171
if (chars) {

‎flang/lib/Semantics/pointer-assignment.cpp‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -244,7 +244,8 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
244244
} else if (const auto *intrinsic{f.proc().GetSpecificIntrinsic()}) {
245245
funcName = intrinsic->name;
246246
}
247-
auto proc{Procedure::Characterize(f.proc(), foldingContext_)};
247+
auto proc{
248+
Procedure::Characterize(f.proc(), foldingContext_, /*emitError=*/true)};
248249
if (!proc) {
249250
return false;
250251
}
@@ -393,7 +394,8 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
393394
symbol->name());
394395
}
395396
}
396-
if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
397+
if (auto chars{
398+
Procedure::Characterize(d, foldingContext_, /*emitError=*/true)}) {
397399
// Disregard the elemental attribute of RHS intrinsics.
398400
if (symbol && symbol->GetUltimate().attrs().test(Attr::INTRINSIC)) {
399401
chars->attrs.reset(Procedure::Attr::Elemental);

‎flang/test/Semantics/resolve102.f90‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,3 +106,16 @@ pure integer function g(n)
106106
g = size(arr)
107107
end function
108108
end
109+
110+
module genericInSpec
111+
interface int
112+
procedure ifunc
113+
end interface
114+
contains
115+
function ifunc(x)
116+
integer a(int(kind(1))) ! generic is ok with most compilers
117+
integer(size(a)), intent(in) :: x
118+
ifunc = x
119+
end
120+
end
121+

0 commit comments

Comments
 (0)