diff options
author | Peter Klausler <35819229+klausler@users.noreply.github.com> | 2024-03-05 10:57:38 -0800 |
---|---|---|
committer | GitHub <noreply@github.com> | 2024-03-05 10:57:38 -0800 |
commit | 3cef82d60796b1f18deebf0d844f38d6e85cd4e7 (patch) | |
tree | 72794236a92b85f193f7c7c15b39c13d4918cb94 | |
parent | 1b812f9cd64c14ab7600626c147da88f21e0217c (diff) | |
download | llvm-3cef82d60796b1f18deebf0d844f38d6e85cd4e7.zip llvm-3cef82d60796b1f18deebf0d844f38d6e85cd4e7.tar.gz llvm-3cef82d60796b1f18deebf0d844f38d6e85cd4e7.tar.bz2 |
[flang] Fix bogus error message about invalid polymorphic entity (#83733)
The check for declarations of polymorphic entities was emitting a bogus
error for one (or more) layers of pointers to procedures returning
pointers to polymorphic types.
Fixes https://github.com/llvm/llvm-project/issues/83292.
-rw-r--r-- | flang/lib/Semantics/check-declarations.cpp | 2 | ||||
-rw-r--r-- | flang/test/Semantics/declarations06.f90 | 9 |
2 files changed, 11 insertions, 0 deletions
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 719bea3..729321d 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -3236,6 +3236,8 @@ void CheckHelper::CheckSymbolType(const Symbol &symbol) { const Symbol *result{FindFunctionResult(symbol)}; const Symbol &relevant{result ? *result : symbol}; if (IsAllocatable(relevant)) { // always ok + } else if (IsProcedurePointer(symbol) && result && IsPointer(*result)) { + // procedure pointer returning allocatable or pointer: ok } else if (IsPointer(relevant) && !IsProcedure(relevant)) { // object pointers are always ok } else if (auto dyType{evaluate::DynamicType::From(relevant)}) { diff --git a/flang/test/Semantics/declarations06.f90 b/flang/test/Semantics/declarations06.f90 index 532b046..ae9ef6a 100644 --- a/flang/test/Semantics/declarations06.f90 +++ b/flang/test/Semantics/declarations06.f90 @@ -16,6 +16,7 @@ module m procedure(cf1), pointer :: pp1 procedure(cf2), pointer :: pp2 procedure(cf3), pointer :: pp3 + procedure(cf5), pointer :: pp4 ! ok contains !ERROR: CLASS entity 'cf1' must be a dummy argument, allocatable, or object pointer class(t) function cf1() @@ -33,4 +34,12 @@ module m !ERROR: CLASS entity 'd3' must be a dummy argument, allocatable, or object pointer class(t), external, pointer :: d3 end + function cf4() + class(t), pointer :: cf4 + cf4 => v3 + end + function cf5 + procedure(cf4), pointer :: cf5 + cf5 => cf4 + end end |