[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
This commit is contained in:
peter klausler 2021-09-14 12:44:57 -07:00
parent 36aac53b36
commit 20afd38651
2 changed files with 22 additions and 6 deletions

View File

@ -502,13 +502,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
static void CheckProcedureArg(evaluate::ActualArgument &arg,
const characteristics::DummyProcedure &proc, const std::string &dummyName,
const characteristics::Procedure &proc,
const characteristics::DummyProcedure &dummy, const std::string &dummyName,
evaluate::FoldingContext &context) {
parser::ContextualMessages &messages{context.messages()};
const characteristics::Procedure &interface{proc.procedure.value()};
const characteristics::Procedure &interface { dummy.procedure.value() };
if (const auto *expr{arg.UnwrapExpr()}) {
bool dummyIsPointer{
proc.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
const auto *argProcDesignator{
std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
const auto *argProcSymbol{
@ -549,6 +550,10 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
"Actual procedure argument has interface incompatible with %s"_err_en_US,
dummyName);
return;
} else if (proc.IsPure()) {
messages.Say(
"Actual procedure argument for %s of a PURE procedure must have an explicit interface"_err_en_US,
dummyName);
} else {
messages.Say(
"Actual procedure argument has an implicit interface "
@ -594,7 +599,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
}
}
if (interface.HasExplicitInterface() && dummyIsPointer &&
proc.intent != common::Intent::In) {
dummy.intent != common::Intent::In) {
const Symbol *last{GetLastSymbol(*expr)};
if (!(last && IsProcedurePointer(*last))) {
// 15.5.2.9(5) -- dummy procedure POINTER
@ -661,8 +666,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
}
}
},
[&](const characteristics::DummyProcedure &proc) {
CheckProcedureArg(arg, proc, dummyName, context);
[&](const characteristics::DummyProcedure &dummy) {
CheckProcedureArg(arg, proc, dummy, dummyName, context);
},
[&](const characteristics::AlternateReturn &) {
// All semantic checking is done elsewhere

View File

@ -18,6 +18,14 @@ module m
real, allocatable :: co[:]
end type
contains
integer pure function purefunc(x)
integer, intent(in) :: x
purefunc = x
end function
integer pure function f00(p0)
procedure(purefunc) :: p0
f00 = p0(1)
end function
pure function test(ptr, in, hpd)
use used
type(t), pointer :: ptr, ptr2
@ -29,6 +37,7 @@ module m
type(hasCoarray), pointer :: hcp
integer :: n
common /block/ y
external :: extfunc
!ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
x%a = 0.
!ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
@ -63,6 +72,8 @@ module m
hp = hpd ! C1594(5)
!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'
allocate(alloc, source=hpd)
!ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface
n = f00(extfunc)
contains
pure subroutine internal
type(hasPtr) :: localhp