diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -397,7 +397,8 @@ messages_.Say( "An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US); } - } else if (IsProcedurePointer(symbol) && IsDummy(symbol)) { + } + if (IsProcedurePointer(symbol) && IsDummy(symbol)) { messages_.Say( "A dummy procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US); // The non-dummy case is a hard error that's caught elsewhere. diff --git a/flang/test/Semantics/call01.f90 b/flang/test/Semantics/call01.f90 --- a/flang/test/Semantics/call01.f90 +++ b/flang/test/Semantics/call01.f90 @@ -118,16 +118,19 @@ end function nested end function -subroutine s01(f1, f2, fp1, fp2) +subroutine s01(f1, f2, fp1, fp2, fp3) !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type character*(*) :: f1, f3, fp1 external :: f1, f3 - pointer :: fp1 + pointer :: fp1, fp3 !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type procedure(character*(*)), pointer :: fp2 interface character*(*) function f2() end function + !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type + character*(*) function fp3() + end function !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result character*(*) function f4() end function