Skip to content

Commit 66fdfff

Browse files
committed
[flang] Require explicit interface for some dummy procedures
Some of the circumstances that require that a procedure have an explicit interface at a point of call due to a characteristic of a dummy argument apply to dummy procedures, too. Differential Revision: https://reviews.llvm.org/D136994
1 parent 788390c commit 66fdfff

File tree

5 files changed

+30
-2
lines changed

5 files changed

+30
-2
lines changed

flang/include/flang/Evaluate/characteristics.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -213,6 +213,7 @@ struct DummyProcedure {
213213
bool operator!=(const DummyProcedure &that) const { return !(*this == that); }
214214
bool IsCompatibleWith(
215215
const DummyProcedure &, std::string *whyNot = nullptr) const;
216+
bool CanBePassedViaImplicitInterface() const;
216217
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
217218

218219
CopyableIndirection<Procedure> procedure;

flang/lib/Evaluate/characteristics.cpp

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -404,6 +404,13 @@ bool DummyProcedure::IsCompatibleWith(
404404
return true;
405405
}
406406

407+
bool DummyProcedure::CanBePassedViaImplicitInterface() const {
408+
if ((attrs & Attrs{Attr::Optional, Attr::Pointer}).any()) {
409+
return false; // 15.4.2.2(3)(a)
410+
}
411+
return true;
412+
}
413+
407414
static std::string GetSeenProcs(
408415
const semantics::UnorderedSymbolSet &seenProcs) {
409416
// Sort the symbols so that they appear in the same order on all platforms
@@ -766,6 +773,8 @@ common::Intent DummyArgument::GetIntent() const {
766773
bool DummyArgument::CanBePassedViaImplicitInterface() const {
767774
if (const auto *object{std::get_if<DummyDataObject>(&u)}) {
768775
return object->CanBePassedViaImplicitInterface();
776+
} else if (const auto *proc{std::get_if<DummyProcedure>(&u)}) {
777+
return proc->CanBePassedViaImplicitInterface();
769778
} else {
770779
return true;
771780
}

flang/lib/Semantics/check-call.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -964,7 +964,7 @@ void CheckArguments(const characteristics::Procedure &proc,
964964
CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
965965
if (treatingExternalAsImplicit && !buffer.empty()) {
966966
if (auto *msg{messages.Say(
967-
"If the procedure's interface were explicit, this reference would be in error:"_warn_en_US)}) {
967+
"If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) {
968968
buffer.AttachTo(*msg, parser::Severity::Because);
969969
}
970970
}

flang/test/Semantics/call24.f90

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,19 @@ subroutine foo(a_pointer)
88
real, pointer :: a_pointer(:)
99
end subroutine
1010

11+
subroutine bar(a_pointer)
12+
procedure(real), pointer :: a_pointer
13+
end subroutine
14+
15+
subroutine baz(proc)
16+
external :: proc
17+
real, optional :: proc
18+
end subroutine
19+
1120
subroutine test()
1221
real, pointer :: a_pointer(:)
1322
real, pointer :: an_array(:)
23+
intrinsic :: sin
1424

1525
! This call would be allowed if the interface was explicit here,
1626
! but its handling with an implicit interface is different (no
@@ -23,4 +33,12 @@ subroutine test()
2333

2434
!ERROR: References to the procedure 'foo' require an explicit interface
2535
call foo(an_array)
36+
37+
!ERROR: References to the procedure 'bar' require an explicit interface
38+
!WARNING: If the procedure's interface were explicit, this reference would be in error
39+
!BECAUSE: Actual argument associated with procedure pointer dummy argument 'a_pointer=' must be a POINTER unless INTENT(IN)
40+
call bar(sin)
41+
42+
!ERROR: References to the procedure 'baz' require an explicit interface
43+
call baz(sin)
2644
end subroutine

flang/test/Semantics/call25.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ program main
4343
call subr2(notChar)
4444
call subr3(explicitLength)
4545
call subr3(assumedLength)
46-
!CHECK: warning: If the procedure's interface were explicit, this reference would be in error:
46+
!CHECK: warning: If the procedure's interface were explicit, this reference would be in error
4747
!CHECK: because: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
4848
call subr3(notChar)
4949
end program

0 commit comments

Comments
 (0)