[flang] Refine pointer/target test for ASSOCIATED intrinsic
The second argument to the ASSOCIATED intrinsic must be a valid pointer or target. The test for this property only checked the last symbol in a data-reference, but any symbol in the reference with the POINTER or TARGET attribute will do. Differential Revision: https://reviews.llvm.org/D119450
This commit is contained in:
parent
100ec80ab5
commit
82dbe82585
|
@ -2260,22 +2260,18 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
|
|||
"procedure designator"_err_en_US,
|
||||
pointerSymbol->name(), targetName),
|
||||
*pointerSymbol);
|
||||
} else {
|
||||
} else if (targetSymbol) {
|
||||
// object pointer and target
|
||||
if (const Symbol * targetSymbol{GetLastSymbol(*targetExpr)}) {
|
||||
if (!(targetSymbol->attrs().test(semantics::Attr::POINTER) ||
|
||||
targetSymbol->attrs().test(
|
||||
semantics::Attr::TARGET))) {
|
||||
AttachDeclaration(
|
||||
context.messages().Say(
|
||||
"TARGET= argument '%s' must have either "
|
||||
"the POINTER or the TARGET "
|
||||
"attribute"_err_en_US,
|
||||
targetName),
|
||||
*targetSymbol);
|
||||
SymbolVector symbols{GetSymbolVector(*targetExpr)};
|
||||
CHECK(!symbols.empty());
|
||||
if (!GetLastTarget(symbols)) {
|
||||
parser::Message *msg{context.messages().Say(
|
||||
"TARGET= argument '%s' must have either the POINTER or the TARGET attribute"_err_en_US,
|
||||
targetExpr->AsFortran())};
|
||||
for (SymbolRef ref : symbols) {
|
||||
msg = AttachDeclaration(msg, *ref);
|
||||
}
|
||||
}
|
||||
|
||||
if (const auto pointerType{pointerArg->GetType()}) {
|
||||
if (const auto targetType{targetArg->GetType()}) {
|
||||
ok = pointerType->IsTkCompatibleWith(*targetType);
|
||||
|
|
|
@ -12,6 +12,14 @@ subroutine assoc()
|
|||
end function
|
||||
end interface
|
||||
|
||||
type :: t1
|
||||
integer :: n
|
||||
end type t1
|
||||
type :: t2
|
||||
type(t1) :: t1arr(2)
|
||||
type(t1), pointer :: t1ptr(:)
|
||||
end type t2
|
||||
|
||||
contains
|
||||
integer function intFunc(x)
|
||||
integer, intent(in) :: x
|
||||
|
@ -60,6 +68,10 @@ subroutine assoc()
|
|||
procedure(subrInt), pointer :: subProcPointer
|
||||
procedure(), pointer :: implicitProcPointer
|
||||
logical :: lVar
|
||||
type(t1) :: t1x
|
||||
type(t1), target :: t1xtarget
|
||||
type(t2) :: t2x
|
||||
type(t2), target :: t2xtarget
|
||||
|
||||
!ERROR: missing mandatory 'pointer=' argument
|
||||
lVar = associated()
|
||||
|
@ -91,6 +103,15 @@ subroutine assoc()
|
|||
!ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
|
||||
lVar = associated(intPointerVar1, intVar)
|
||||
|
||||
!ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute
|
||||
lVar = associated(intPointerVar1, t1x%n)
|
||||
lVar = associated(intPointerVar1, t1xtarget%n) ! ok
|
||||
!ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute
|
||||
lVar = associated(intPointerVar1, t2x%t1arr(1)%n)
|
||||
lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok
|
||||
lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok
|
||||
lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok
|
||||
|
||||
! Procedure pointer tests
|
||||
intprocPointer1 => intProc !OK
|
||||
lVar = associated(intprocPointer1, intProc) !OK
|
||||
|
|
Loading…
Reference in a new issue