[flang-commits] [flang] [flang] Accept proc ptr function result as actual argument without IN… (PR #128771)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Feb 26 12:39:38 PST 2025
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/128771
>From 49c438f6a4b9c32eed4878461dce577e947c4076 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 25 Feb 2025 12:51:20 -0800
Subject: [PATCH] [flang] Accept proc ptr function result as actual argument
without INTENT
A dummy procedure pointer with no INTENT attribute may associate with
an actual argument that is the result of a reference to a function that
returns a procedure pointer, we think.
Fixes https://github.com/llvm/llvm-project/issues/126950.
---
flang/lib/Semantics/check-call.cpp | 40 +++++++++++++++++-----------
flang/test/Semantics/call09.f90 | 17 ++++++------
flang/test/Semantics/call24.f90 | 2 +-
flang/test/Semantics/definable01.f90 | 3 ++-
4 files changed, 35 insertions(+), 27 deletions(-)
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index e396ece303103..433e56da6a6cb 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1049,8 +1049,8 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
SemanticsContext &context, bool ignoreImplicitVsExplicit) {
evaluate::FoldingContext &foldingContext{context.foldingContext()};
parser::ContextualMessages &messages{foldingContext.messages()};
- auto restorer{
- messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
+ parser::CharBlock location{arg.sourceLocation().value_or(messages.at())};
+ auto restorer{messages.SetLocation(location)};
const characteristics::Procedure &interface { dummy.procedure.value() };
if (const auto *expr{arg.UnwrapExpr()}) {
bool dummyIsPointer{
@@ -1175,22 +1175,30 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
dummyName);
}
}
- if (dummyIsPointer && dummy.intent != common::Intent::In) {
- const Symbol *last{GetLastSymbol(*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
+ if (dummyIsPointer) {
+ if (dummy.intent == common::Intent::In) {
+ // need not be definable, can be a target
+ } else if (!IsProcedurePointer(*expr)) {
messages.Say(
- "Actual argument associated with procedure pointer %s must be a pointer unless INTENT(IN)"_err_en_US,
+ "Actual argument associated with procedure pointer %s is not a procedure pointer"_err_en_US,
dummyName);
+ } else if (dummy.intent == common::Intent::Default) {
+ // ok, needs to be definable only if defined at run time
+ } else {
+ DefinabilityFlags flags{DefinabilityFlag::PointerDefinition};
+ if (dummy.intent != common::Intent::Out) {
+ flags.set(DefinabilityFlag::DoNotNoteDefinition);
+ }
+ if (auto whyNot{WhyNotDefinable(
+ location, context.FindScope(location), flags, *expr)}) {
+ if (auto *msg{messages.Say(
+ "Actual argument associated with INTENT(%s) procedure pointer %s is not definable"_err_en_US,
+ dummy.intent == common::Intent::Out ? "OUT" : "IN OUT",
+ dummyName)}) {
+ msg->Attach(
+ std::move(whyNot->set_severity(parser::Severity::Because)));
+ }
+ }
}
}
} else {
diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90
index b8583ba4a4907..58b2382f600ef 100644
--- a/flang/test/Semantics/call09.f90
+++ b/flang/test/Semantics/call09.f90
@@ -82,27 +82,26 @@ subroutine test1 ! 15.5.2.9(5)
call s01(null(intPtr))
!ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
call s01(B"0101")
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
+ !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
call s02(realfunc)
call s02(p) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s02(ip)
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
- call s02(procptr())
+ call s02(procptr()) ! believed to be ok
call s02(null()) ! ok
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
+ !ERROR: Actual argument associated with INTENT(IN OUT) procedure pointer dummy argument 'p=' is not definable
+ !BECAUSE: 'NULL()' is a null pointer
call s05(null())
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
+ !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
call s02(sin)
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
+ !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
call s02b(realfunc)
call s02b(p) ! ok
!ERROR: Actual argument function associated with procedure dummy argument 'p=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call s02b(ip)
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
- call s02b(procptr())
+ call s02b(procptr()) ! believed to be ok
call s02b(null())
- !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
+ !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
call s02b(sin)
end subroutine
diff --git a/flang/test/Semantics/call24.f90 b/flang/test/Semantics/call24.f90
index 78ee17b488676..c1053db93648f 100644
--- a/flang/test/Semantics/call24.f90
+++ b/flang/test/Semantics/call24.f90
@@ -39,7 +39,7 @@ subroutine test()
!ERROR: References to the procedure 'bar' require an explicit interface
!BECAUSE: a dummy procedure is optional or a pointer
!WARNING: If the procedure's interface were explicit, this reference would be in error
- !BECAUSE: Actual argument associated with procedure pointer dummy argument 'a_pointer=' must be a pointer unless INTENT(IN)
+ !BECAUSE: Actual argument associated with procedure pointer dummy argument 'a_pointer=' is not a procedure pointer
call bar(sin)
!ERROR: References to the procedure 'baz' require an explicit interface
diff --git a/flang/test/Semantics/definable01.f90 b/flang/test/Semantics/definable01.f90
index d3b31ee38b2a3..5af7e954e4171 100644
--- a/flang/test/Semantics/definable01.f90
+++ b/flang/test/Semantics/definable01.f90
@@ -77,7 +77,8 @@ subroutine test3(objp, 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)
+ !CHECK: error: Actual argument associated with INTENT(IN OUT) procedure pointer dummy argument 'pp=' is not definable
+ !CHECK: because: 'procp' is an INTENT(IN) dummy argument
call test3b(procp)
end subroutine
subroutine test3a(op)
More information about the flang-commits
mailing list