aboutsummaryrefslogtreecommitdiff
path: root/flang
diff options
context:
space:
mode:
authorPeter Klausler <pklausler@nvidia.com>2023-07-20 12:37:25 -0700
committerPeter Klausler <pklausler@nvidia.com>2023-07-21 15:34:53 -0700
commit24d293913c211c43af4d1ab0a23ab66d58aea6df (patch)
tree20c9ad80964232563a53d1ba4a98a5a1351708bd /flang
parenteaa4bc655709520f752e81890e5154775e66d539 (diff)
downloadllvm-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.cpp3
-rw-r--r--flang/test/Semantics/call01.f907
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