OSchip
/
llvm-project
mirror of https://github.com/THU-DSP-LAB/llvm-project.git
13
0
Fork 2
Code Issues Packages Projects Releases Wiki Activity

[flang] INTENT(IN) pointer may not be forwarded to INTENT(IN OUT) or (OUT) dummy 

19.6.8 forbids using an INTENT(IN) pointer dummy argument in a pointer association
context, and associated such a pointer with a dummy argument of INTENT(IN OUT) or
INTENT(OUT) is a circumstance that needs to be caught as an error.

Differential Revision: https://reviews.llvm.org/D139138
This commit is contained in:
Peter Klausler 2022-11-13 17:08:01 -08:00
parent 4509fb9c00
commit 066aecff92
2 changed files with 44 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
flang/lib/Semantics/check-call.cpp
View File

@ -391,25 +391,28 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
// Definability
if (scope) {
const char *reason{nullptr};
const char *reason{nullptr};
if (dummy.intent == common::Intent::Out) {
reason = "INTENT(OUT)";
} else if (dummy.intent == common::Intent::InOut) {
reason = "INTENT(IN OUT)";
}
bool dummyIsPointer{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
if (reason && scope) {
// Problems with polymorphism are caught in the callee's definition.
DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure};
if (dummy.intent == common::Intent::Out) {
reason = "INTENT(OUT)";
} else if (dummy.intent == common::Intent::InOut) {
reason = "INTENT(IN OUT)";
if (isElemental || dummyIsValue) { // 15.5.2.4(21)
flags.set(DefinabilityFlag::VectorSubscriptIsOk);
}
if (reason) {
if (isElemental || dummyIsValue) { // 15.5.2.4(21)
flags.set(DefinabilityFlag::VectorSubscriptIsOk);
}
if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
if (auto *msg{messages.Say(
"Actual argument associated with %s %s is not definable"_err_en_US,
reason, dummyName)}) {
msg->Attach(std::move(*whyNot));
}
if (actualIsPointer && dummyIsPointer) { // 19.6.8
flags.set(DefinabilityFlag::PointerDefinition);
}
if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
if (auto *msg{messages.Say(
"Actual argument associated with %s %s is not definable"_err_en_US,
reason, dummyName)}) {
msg->Attach(std::move(*whyNot));
}
}
}
@ -418,8 +421,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
bool actualIsContiguous{IsSimplyContiguous(actual, context)};
bool dummyIsAssumedShape{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)};
bool dummyIsPointer{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
bool dummyIsContiguous{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
if ((actualIsAsynchronous || actualIsVolatile) &&
@ -691,9 +692,15 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
}
if (dummyIsPointer && dummy.intent != common::Intent::In) {
const Symbol *last{GetLastSymbol(*expr)};
if (!(last && IsProcedurePointer(*last)) &&
!(dummy.intent == common::Intent::Default &&
IsNullProcedurePointer(*expr))) {
if (last && IsProcedurePointer(*last)) {
if (dummy.intent != common::Intent::Default &&
IsIntentIn(last->GetUltimate())) { // 19.6.8
messages.Say(
"Actual argument associated with procedure pointer %s may not be INTENT(IN)"_err_en_US,
dummyName);
}
} else if (!(dummy.intent == common::Intent::Default &&
IsNullProcedurePointer(*expr))) {
// 15.5.2.9(5) -- dummy procedure POINTER
// Interface compatibility has already been checked above
messages.Say(

17
flang/test/Semantics/modifiable01.f90 → flang/test/Semantics/definable01.f90
View File

@ -1,5 +1,5 @@
! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
! Test WhyNotModifiable() explanations
! Test WhyNotDefinable() explanations
module prot
real, protected :: prot
@ -67,4 +67,19 @@ module m
!CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
read(internal,*) ptr
end subroutine
subroutine test3(objp, procp)
real, intent(in), pointer :: objp
procedure(sin), pointer, intent(in) :: procp
!CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable
!CHECK: because: 'objp' is an INTENT(IN) dummy argument
call test3a(objp)
!CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN)
call test3b(procp)
end subroutine
subroutine test3a(op)
real, intent(in out), pointer :: op
end subroutine
subroutine test3b(pp)
procedure(sin), pointer, intent(in out) :: pp
end subroutine
end module