Skip to content

Commit 3e3855b

Browse files
authored
[flang] Don't flag CLASS(*) ASSOCIATED() pointer or target as error (#125890)
As I read the standard, an unlimited polymorphic pointer or target should be viewed as compatible with any data target or data pointer when used in the two-argument form of the intrinsic function ASSOCIATED(). Fixes #125774.
1 parent 29025a0 commit 3e3855b

File tree

2 files changed

+19
-1
lines changed

2 files changed

+19
-1
lines changed

flang/lib/Semantics/check-call.cpp

+4-1
Original file line numberDiff line numberDiff line change
@@ -1483,6 +1483,8 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
14831483
}
14841484
if (const auto &targetArg{arguments[1]}) {
14851485
// The standard requires that the TARGET= argument, when present,
1486+
// be type compatible with the POINTER= for a data pointer. In
1487+
// the case of procedure pointers, the standard requires that it
14861488
// be a valid RHS for a pointer assignment that has the POINTER=
14871489
// argument as its LHS. Some popular compilers misinterpret this
14881490
// requirement more strongly than necessary, and actually validate
@@ -1589,7 +1591,8 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
15891591
}
15901592
if (const auto pointerType{pointerArg->GetType()}) {
15911593
if (const auto targetType{targetArg->GetType()}) {
1592-
ok = pointerType->IsTkCompatibleWith(*targetType);
1594+
ok = pointerType->IsTkCompatibleWith(*targetType) ||
1595+
targetType->IsTkCompatibleWith(*pointerType);
15931596
}
15941597
}
15951598
} else {

flang/test/Semantics/bug125774.f90

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1
2+
type t
3+
end type
4+
real, pointer :: rptr
5+
type(t), pointer :: tptr
6+
class(*), pointer :: ulpp
7+
print *, associated(rptr, ulpp)
8+
print *, associated(ulpp, rptr)
9+
print *, associated(tptr, ulpp)
10+
print *, associated(ulpp, tptr)
11+
!ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target
12+
print *, associated(rptr, tptr)
13+
!ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target
14+
print *, associated(tptr, rptr)
15+
end

0 commit comments

Comments
 (0)