forked from OSchip/llvm-project
[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:
parent
36aac53b36
commit
20afd38651
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue