diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -213,6 +213,7 @@ bool operator!=(const DummyProcedure &that) const { return !(*this == that); } bool IsCompatibleWith( const DummyProcedure &, std::string *whyNot = nullptr) const; + bool CanBePassedViaImplicitInterface() const; llvm::raw_ostream &Dump(llvm::raw_ostream &) const; CopyableIndirection procedure; diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -404,6 +404,13 @@ return true; } +bool DummyProcedure::CanBePassedViaImplicitInterface() const { + if ((attrs & Attrs{Attr::Optional, Attr::Pointer}).any()) { + return false; // 15.4.2.2(3)(a) + } + return true; +} + static std::string GetSeenProcs( const semantics::UnorderedSymbolSet &seenProcs) { // Sort the symbols so that they appear in the same order on all platforms @@ -766,6 +773,8 @@ bool DummyArgument::CanBePassedViaImplicitInterface() const { if (const auto *object{std::get_if(&u)}) { return object->CanBePassedViaImplicitInterface(); + } else if (const auto *proc{std::get_if(&u)}) { + return proc->CanBePassedViaImplicitInterface(); } else { return true; } diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -964,7 +964,7 @@ CheckExplicitInterface(proc, actuals, context, scope, intrinsic)}; if (treatingExternalAsImplicit && !buffer.empty()) { if (auto *msg{messages.Say( - "If the procedure's interface were explicit, this reference would be in error:"_warn_en_US)}) { + "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) { buffer.AttachTo(*msg, parser::Severity::Because); } } diff --git a/flang/test/Semantics/call24.f90 b/flang/test/Semantics/call24.f90 --- a/flang/test/Semantics/call24.f90 +++ b/flang/test/Semantics/call24.f90 @@ -8,9 +8,19 @@ real, pointer :: a_pointer(:) end subroutine +subroutine bar(a_pointer) + procedure(real), pointer :: a_pointer +end subroutine + +subroutine baz(proc) + external :: proc + real, optional :: proc +end subroutine + subroutine test() real, pointer :: a_pointer(:) real, pointer :: an_array(:) + intrinsic :: sin ! This call would be allowed if the interface was explicit here, ! but its handling with an implicit interface is different (no @@ -23,4 +33,12 @@ !ERROR: References to the procedure 'foo' require an explicit interface call foo(an_array) + + !ERROR: References to the procedure 'bar' require an explicit interface + !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) + call bar(sin) + + !ERROR: References to the procedure 'baz' require an explicit interface + call baz(sin) end subroutine diff --git a/flang/test/Semantics/call25.f90 b/flang/test/Semantics/call25.f90 --- a/flang/test/Semantics/call25.f90 +++ b/flang/test/Semantics/call25.f90 @@ -43,7 +43,7 @@ call subr2(notChar) call subr3(explicitLength) call subr3(assumedLength) - !CHECK: warning: If the procedure's interface were explicit, this reference would be in error: + !CHECK: warning: If the procedure's interface were explicit, this reference would be in error !CHECK: because: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type call subr3(notChar) end program