Skip to content

[flang] Accept proc ptr function result as actual argument without IN… #128771

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Feb 27, 2025
Merged

[flang] Accept proc ptr function result as actual argument without IN… #128771

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 24 additions & 16 deletions flang/lib/Semantics/check-call.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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{
Expand Down Expand Up @@ -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 {
Expand Down
17 changes: 8 additions & 9 deletions flang/test/Semantics/call09.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion flang/test/Semantics/call24.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion flang/test/Semantics/definable01.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down