diff options
author | Peter Klausler <pklausler@nvidia.com> | 2023-07-20 12:37:25 -0700 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2023-07-21 15:34:53 -0700 |
commit | 24d293913c211c43af4d1ab0a23ab66d58aea6df (patch) | |
tree | 20c9ad80964232563a53d1ba4a98a5a1351708bd /flang | |
parent | eaa4bc655709520f752e81890e5154775e66d539 (diff) | |
download | llvm-24d293913c211c43af4d1ab0a23ab66d58aea6df.zip llvm-24d293913c211c43af4d1ab0a23ab66d58aea6df.tar.gz llvm-24d293913c211c43af4d1ab0a23ab66d58aea6df.tar.bz2 |
[flang] Fix portability warning that was incorrectly an "else if"
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
Diffstat (limited to 'flang')
-rw-r--r-- | flang/lib/Semantics/check-declarations.cpp | 3 | ||||
-rw-r--r-- | flang/test/Semantics/call01.f90 | 7 |
2 files changed, 7 insertions, 3 deletions
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 337f1a0..d9259f4 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -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. diff --git a/flang/test/Semantics/call01.f90 b/flang/test/Semantics/call01.f90 index 40f7bef..dda1a7f 100644 --- a/flang/test/Semantics/call01.f90 +++ b/flang/test/Semantics/call01.f90 @@ -118,16 +118,19 @@ function f14(n) result(res) 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 |