Skip to content

Commit 5748bd1

Browse files
klauslerjeanPerier
authored andcommitted
[flang] Upgrade warning to error in case of PURE procedure
A procedure actual argument to a PURE procedure should be required to have an explicit interface. Implicit-interface actual arguments to non-PURE procedures remain a warning. Differential Revision: https://reviews.llvm.org/D109926
1 parent 9682b1f commit 5748bd1

File tree

2 files changed

+22
-6
lines changed

2 files changed

+22
-6
lines changed

flang/lib/Semantics/check-call.cpp

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -502,13 +502,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
502502
}
503503

504504
static void CheckProcedureArg(evaluate::ActualArgument &arg,
505-
const characteristics::DummyProcedure &proc, const std::string &dummyName,
505+
const characteristics::Procedure &proc,
506+
const characteristics::DummyProcedure &dummy, const std::string &dummyName,
506507
evaluate::FoldingContext &context) {
507508
parser::ContextualMessages &messages{context.messages()};
508-
const characteristics::Procedure &interface{proc.procedure.value()};
509+
const characteristics::Procedure &interface { dummy.procedure.value() };
509510
if (const auto *expr{arg.UnwrapExpr()}) {
510511
bool dummyIsPointer{
511-
proc.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
512+
dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
512513
const auto *argProcDesignator{
513514
std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
514515
const auto *argProcSymbol{
@@ -549,6 +550,10 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
549550
"Actual procedure argument has interface incompatible with %s"_err_en_US,
550551
dummyName);
551552
return;
553+
} else if (proc.IsPure()) {
554+
messages.Say(
555+
"Actual procedure argument for %s of a PURE procedure must have an explicit interface"_err_en_US,
556+
dummyName);
552557
} else {
553558
messages.Say(
554559
"Actual procedure argument has an implicit interface "
@@ -594,7 +599,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
594599
}
595600
}
596601
if (interface.HasExplicitInterface() && dummyIsPointer &&
597-
proc.intent != common::Intent::In) {
602+
dummy.intent != common::Intent::In) {
598603
const Symbol *last{GetLastSymbol(*expr)};
599604
if (!(last && IsProcedurePointer(*last))) {
600605
// 15.5.2.9(5) -- dummy procedure POINTER
@@ -661,8 +666,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
661666
}
662667
}
663668
},
664-
[&](const characteristics::DummyProcedure &proc) {
665-
CheckProcedureArg(arg, proc, dummyName, context);
669+
[&](const characteristics::DummyProcedure &dummy) {
670+
CheckProcedureArg(arg, proc, dummy, dummyName, context);
666671
},
667672
[&](const characteristics::AlternateReturn &) {
668673
// All semantic checking is done elsewhere

flang/test/Semantics/call12.f90

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,14 @@ module m
1818
real, allocatable :: co[:]
1919
end type
2020
contains
21+
integer pure function purefunc(x)
22+
integer, intent(in) :: x
23+
purefunc = x
24+
end function
25+
integer pure function f00(p0)
26+
procedure(purefunc) :: p0
27+
f00 = p0(1)
28+
end function
2129
pure function test(ptr, in, hpd)
2230
use used
2331
type(t), pointer :: ptr, ptr2
@@ -29,6 +37,7 @@ pure function test(ptr, in, hpd)
2937
type(hasCoarray), pointer :: hcp
3038
integer :: n
3139
common /block/ y
40+
external :: extfunc
3241
!ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
3342
x%a = 0.
3443
!ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
@@ -63,6 +72,8 @@ pure function test(ptr, in, hpd)
6372
hp = hpd ! C1594(5)
6473
!ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
6574
allocate(alloc, source=hpd)
75+
!ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface
76+
n = f00(extfunc)
6677
contains
6778
pure subroutine internal
6879
type(hasPtr) :: localhp

0 commit comments

Comments
 (0)