Skip to content

Commit 614ccc8

Browse files
klauslerklausler
committed
[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 #88677.
1 parent e8e6795 commit 614ccc8

File tree

10 files changed

+78
-52
lines changed

10 files changed

+78
-52
lines changed

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

+1-1
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

+42-33
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,22 @@ static std::optional<Procedure> CharacterizeProcedure(
591591
return std::nullopt;
592592
}
593593
seenProcs.insert(symbol);
594+
auto CheckForNested{[&](const Symbol &symbol) {
595+
if (emitError) {
596+
CHECK(!getenv("PMK"));
597+
context.messages().Say(
598+
"Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
599+
symbol.name());
600+
}
601+
}};
594602
auto result{common::visit(
595603
common::visitors{
596604
[&](const semantics::SubprogramDetails &subp)
597605
-> std::optional<Procedure> {
598606
Procedure result;
599607
if (subp.isFunction()) {
600608
if (auto fr{CharacterizeFunctionResult(
601-
subp.result(), context, seenProcs)}) {
609+
subp.result(), context, seenProcs, emitError)}) {
602610
result.functionResult = std::move(fr);
603611
} else {
604612
return std::nullopt;
@@ -641,8 +649,8 @@ static std::optional<Procedure> CharacterizeProcedure(
641649
}
642650
if (const semantics::Symbol *
643651
interfaceSymbol{proc.procInterface()}) {
644-
auto result{
645-
CharacterizeProcedure(*interfaceSymbol, context, seenProcs)};
652+
auto result{CharacterizeProcedure(
653+
*interfaceSymbol, context, seenProcs, /*emitError=*/false)};
646654
if (result && (IsDummy(symbol) || IsPointer(symbol))) {
647655
// Dummy procedures and procedure pointers may not be
648656
// ELEMENTAL, but we do accept the use of elemental intrinsic
@@ -675,8 +683,8 @@ static std::optional<Procedure> CharacterizeProcedure(
675683
}
676684
},
677685
[&](const semantics::ProcBindingDetails &binding) {
678-
if (auto result{CharacterizeProcedure(
679-
binding.symbol(), context, seenProcs)}) {
686+
if (auto result{CharacterizeProcedure(binding.symbol(), context,
687+
seenProcs, /*emitError=*/false)}) {
680688
if (binding.symbol().attrs().test(semantics::Attr::INTRINSIC)) {
681689
result->attrs.reset(Procedure::Attr::Elemental);
682690
}
@@ -695,33 +703,32 @@ static std::optional<Procedure> CharacterizeProcedure(
695703
}
696704
},
697705
[&](const semantics::UseDetails &use) {
698-
return CharacterizeProcedure(use.symbol(), context, seenProcs);
706+
return CharacterizeProcedure(
707+
use.symbol(), context, seenProcs, /*emitError=*/false);
699708
},
700709
[](const semantics::UseErrorDetails &) {
701710
// Ambiguous use-association will be handled later during symbol
702711
// checks, ignore UseErrorDetails here without actual symbol usage.
703712
return std::optional<Procedure>{};
704713
},
705714
[&](const semantics::HostAssocDetails &assoc) {
706-
return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
715+
return CharacterizeProcedure(
716+
assoc.symbol(), context, seenProcs, /*emitError=*/false);
707717
},
708718
[&](const semantics::GenericDetails &generic) {
709719
if (const semantics::Symbol * specific{generic.specific()}) {
710-
return CharacterizeProcedure(*specific, context, seenProcs);
720+
return CharacterizeProcedure(
721+
*specific, context, seenProcs, emitError);
711722
} else {
712723
return std::optional<Procedure>{};
713724
}
714725
},
715726
[&](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());
727+
CheckForNested(symbol);
719728
return std::optional<Procedure>{};
720729
},
721730
[&](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());
731+
CheckForNested(symbol);
725732
return std::optional<Procedure>{};
726733
},
727734
[&](const auto &) {
@@ -752,7 +759,8 @@ static std::optional<Procedure> CharacterizeProcedure(
752759
static std::optional<DummyProcedure> CharacterizeDummyProcedure(
753760
const semantics::Symbol &symbol, FoldingContext &context,
754761
semantics::UnorderedSymbolSet seenProcs) {
755-
if (auto procedure{CharacterizeProcedure(symbol, context, seenProcs)}) {
762+
if (auto procedure{CharacterizeProcedure(
763+
symbol, context, seenProcs, /*emitError=*/true)}) {
756764
// Dummy procedures may not be elemental. Elemental dummy procedure
757765
// interfaces are errors when the interface is not intrinsic, and that
758766
// error is caught elsewhere. Elemental intrinsic interfaces are
@@ -854,7 +862,8 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
854862
std::move(name), std::move(obj));
855863
},
856864
[&](const ProcedureDesignator &designator) {
857-
if (auto proc{Procedure::Characterize(designator, context)}) {
865+
if (auto proc{Procedure::Characterize(
866+
designator, context, /*emitError=*/true)}) {
858867
return std::make_optional<DummyArgument>(
859868
std::move(name), DummyProcedure{std::move(*proc)});
860869
} else {
@@ -988,7 +997,7 @@ bool FunctionResult::operator==(const FunctionResult &that) const {
988997

989998
static std::optional<FunctionResult> CharacterizeFunctionResult(
990999
const semantics::Symbol &symbol, FoldingContext &context,
991-
semantics::UnorderedSymbolSet seenProcs) {
1000+
semantics::UnorderedSymbolSet seenProcs, bool emitError) {
9921001
if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
9931002
if (auto type{TypeAndShape::Characterize(
9941003
symbol, context, /*invariantOnly=*/false)}) {
@@ -1002,8 +1011,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
10021011
result.cudaDataAttr = object->cudaDataAttr();
10031012
return result;
10041013
}
1005-
} else if (auto maybeProc{
1006-
CharacterizeProcedure(symbol, context, seenProcs)}) {
1014+
} else if (auto maybeProc{CharacterizeProcedure(
1015+
symbol, context, seenProcs, emitError)}) {
10071016
FunctionResult result{std::move(*maybeProc)};
10081017
result.attrs.set(FunctionResult::Attr::Pointer);
10091018
return result;
@@ -1014,7 +1023,8 @@ static std::optional<FunctionResult> CharacterizeFunctionResult(
10141023
std::optional<FunctionResult> FunctionResult::Characterize(
10151024
const Symbol &symbol, FoldingContext &context) {
10161025
semantics::UnorderedSymbolSet seenProcs;
1017-
return CharacterizeFunctionResult(symbol, context, seenProcs);
1026+
return CharacterizeFunctionResult(
1027+
symbol, context, seenProcs, /*emitError=*/false);
10181028
}
10191029

10201030
bool FunctionResult::IsAssumedLengthCharacter() const {
@@ -1360,27 +1370,26 @@ bool Procedure::CanOverride(
13601370
}
13611371

13621372
std::optional<Procedure> Procedure::Characterize(
1363-
const semantics::Symbol &original, FoldingContext &context) {
1373+
const semantics::Symbol &symbol, FoldingContext &context) {
13641374
semantics::UnorderedSymbolSet seenProcs;
1365-
return CharacterizeProcedure(original, context, seenProcs);
1375+
return CharacterizeProcedure(symbol, context, seenProcs, /*emitError=*/true);
13661376
}
13671377

13681378
std::optional<Procedure> Procedure::Characterize(
1369-
const ProcedureDesignator &proc, FoldingContext &context) {
1379+
const ProcedureDesignator &proc, FoldingContext &context, bool emitError) {
13701380
if (const auto *symbol{proc.GetSymbol()}) {
1371-
if (auto result{
1372-
characteristics::Procedure::Characterize(*symbol, context)}) {
1373-
return result;
1374-
}
1381+
semantics::UnorderedSymbolSet seenProcs;
1382+
return CharacterizeProcedure(*symbol, context, seenProcs, emitError);
13751383
} else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {
13761384
return intrinsic->characteristics.value();
1385+
} else {
1386+
return std::nullopt;
13771387
}
1378-
return std::nullopt;
13791388
}
13801389

13811390
std::optional<Procedure> Procedure::Characterize(
13821391
const ProcedureRef &ref, FoldingContext &context) {
1383-
if (auto callee{Characterize(ref.proc(), context)}) {
1392+
if (auto callee{Characterize(ref.proc(), context, /*emitError=*/true)}) {
13841393
if (callee->functionResult) {
13851394
if (const Procedure *
13861395
proc{callee->functionResult->IsProcedurePointer()}) {
@@ -1397,7 +1406,7 @@ std::optional<Procedure> Procedure::Characterize(
13971406
return Characterize(*procRef, context);
13981407
} else if (const auto *procDesignator{
13991408
std::get_if<ProcedureDesignator>(&expr.u)}) {
1400-
return Characterize(*procDesignator, context);
1409+
return Characterize(*procDesignator, context, /*emitError=*/true);
14011410
} else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
14021411
return Characterize(*symbol, context);
14031412
} else {
@@ -1409,7 +1418,7 @@ std::optional<Procedure> Procedure::Characterize(
14091418

14101419
std::optional<Procedure> Procedure::FromActuals(const ProcedureDesignator &proc,
14111420
const ActualArguments &args, FoldingContext &context) {
1412-
auto callee{Characterize(proc, context)};
1421+
auto callee{Characterize(proc, context, /*emitError=*/true)};
14131422
if (callee) {
14141423
if (callee->dummyArguments.empty() &&
14151424
callee->attrs.test(Procedure::Attr::ImplicitInterface)) {

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

+6-6
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

+2-2
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

+2-1
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

+3-3
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
@@ -1543,7 +1543,7 @@ class SignatureBuilder
15431543
Fortran::lower::AbstractConverter &c)
15441544
: CallInterface{c}, procDesignator{&procDes},
15451545
proc{Fortran::evaluate::characteristics::Procedure::Characterize(
1546-
procDes, converter.getFoldingContext())
1546+
procDes, converter.getFoldingContext(), /*emitError=*/false)
15471547
.value()} {}
15481548
/// Does the procedure characteristics being translated have alternate
15491549
/// returns ?
@@ -1672,7 +1672,7 @@ bool Fortran::lower::mustPassLengthWithDummyProcedure(
16721672
Fortran::lower::AbstractConverter &converter) {
16731673
std::optional<Fortran::evaluate::characteristics::Procedure> characteristics =
16741674
Fortran::evaluate::characteristics::Procedure::Characterize(
1675-
procedure, converter.getFoldingContext());
1675+
procedure, converter.getFoldingContext(), /*emitError=*/false);
16761676
return ::mustPassLengthWithDummyProcedure(characteristics);
16771677
}
16781678

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

+2-2
Original file line numberDiff line numberDiff line change
@@ -1597,8 +1597,8 @@ static void CheckReduce(
15971597
if (const auto *expr{operation->UnwrapExpr()}) {
15981598
if (const auto *designator{
15991599
std::get_if<evaluate::ProcedureDesignator>(&expr->u)}) {
1600-
procChars =
1601-
characteristics::Procedure::Characterize(*designator, context);
1600+
procChars = characteristics::Procedure::Characterize(
1601+
*designator, context, /*emitError=*/true);
16021602
} else if (const auto *ref{
16031603
std::get_if<evaluate::ProcedureRef>(&expr->u)}) {
16041604
procChars = characteristics::Procedure::Characterize(*ref, context);

‎flang/lib/Semantics/expression.cpp

+3-2
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

+4-2
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

+13
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)