Skip to content

Commit

Permalink
[flang] Fix portability warning that was incorrectly an "else if"
Browse files Browse the repository at this point in the history
A semantics check for an assumed-length dummy procedure pointer was
inappropriately part of an "else" clause for a preceding check,
causing it to not be applied in all situations.

Differential Revision: https://reviews.llvm.org/D155975
  • Loading branch information
klausler committed Jul 21, 2023
1 parent eaa4bc6 commit 24d2939
Show file tree
Hide file tree
Showing 2 changed files with 7 additions and 3 deletions.
3 changes: 2 additions & 1 deletion flang/lib/Semantics/check-declarations.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -397,7 +397,8 @@ void CheckHelper::Check(const Symbol &symbol) {
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.
Expand Down
7 changes: 5 additions & 2 deletions flang/test/Semantics/call01.f90
Original file line number Diff line number Diff line change
Expand Up @@ -118,16 +118,19 @@ character(1) function nested
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
Expand Down

0 comments on commit 24d2939

Please sign in to comment.