[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.
This commit is contained in:
Peter Klausler 2024-03-05 10:57:38 -08:00 committed by GitHub
parent 1b812f9cd6
commit 3cef82d607
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 11 additions and 0 deletions

View File

@ -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)}) {

View File

@ -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