[flang] Do not return true for pointer sub-object in IsPointerObject
evaluate::IsPointerObject used to return true for pointer suboject like `pointer(10)` while these object are not pointers. This prevented some checks like 15.5.2.7 to be correctly enforced (e.g., it was possible to pass `pointer(10)` to a non intent(in) dummy pointer). After updating IsPointerObject behavior and adding a test for 15.5.2.7 in call07.f90, a test in call03.f90 for 15.5.2.4(14) was failing. It appeared the related semantics check was relying on IsPointerObject to return true for `pointer(10)`. Adapt the code to detect pointer element in another way. While looking at the code, I also noticed that semantics was rejecting `character(1)` pointer/assumed shape suboject when these are allowed (the standard has a special case for character(1) in 15.5.2.4(14), and I verified that other compilers that enforce 15.5.2.4(14) do accept this). Differential Revision: https://reviews.llvm.org/D121377
This commit is contained in:
parent
3ed643ea76
commit
a7802a806d
|
@ -767,7 +767,7 @@ bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
|
|||
return false;
|
||||
} else if (const auto *funcRef{UnwrapProcedureRef(expr)}) {
|
||||
return IsVariable(*funcRef);
|
||||
} else if (const Symbol * symbol{GetLastSymbol(expr)}) {
|
||||
} else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
|
||||
return IsPointer(symbol->GetUltimate());
|
||||
} else {
|
||||
return false;
|
||||
|
|
|
@ -309,29 +309,34 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
"Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (!IsArrayElement(actual) &&
|
||||
!(actualType.type().category() == TypeCategory::Character &&
|
||||
actualType.type().kind() == 1) &&
|
||||
!(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
|
||||
!dummyIsAssumedRank) {
|
||||
messages.Say(
|
||||
"Whole scalar actual argument may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualIsPolymorphic) {
|
||||
messages.Say(
|
||||
"Polymorphic scalar may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualIsPointer) {
|
||||
messages.Say(
|
||||
"Scalar POINTER target may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) {
|
||||
messages.Say(
|
||||
"Element of assumed-shape array may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
bool actualIsArrayElement{IsArrayElement(actual)};
|
||||
bool actualIsCKindCharacter{
|
||||
actualType.type().category() == TypeCategory::Character &&
|
||||
actualType.type().kind() == 1};
|
||||
if (!actualIsCKindCharacter) {
|
||||
if (!actualIsArrayElement &&
|
||||
!(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
|
||||
!dummyIsAssumedRank) {
|
||||
messages.Say(
|
||||
"Whole scalar actual argument may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualIsPolymorphic) {
|
||||
messages.Say(
|
||||
"Polymorphic scalar may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualIsArrayElement && actualLastSymbol &&
|
||||
IsPointer(*actualLastSymbol)) {
|
||||
messages.Say(
|
||||
"Element of pointer array may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) {
|
||||
messages.Say(
|
||||
"Element of assumed-shape array may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (actualLastObject && actualLastObject->IsCoarray() &&
|
||||
|
|
|
@ -196,21 +196,28 @@ module m01
|
|||
subroutine charray(x)
|
||||
character :: x(10)
|
||||
end subroutine
|
||||
subroutine test09(ashape, polyarray, c) ! 15.5.2.4(14), 15.5.2.11
|
||||
subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
|
||||
real :: x, arr(10)
|
||||
real, pointer :: p(:)
|
||||
real, pointer :: p_scalar
|
||||
character(10), pointer :: char_pointer(:)
|
||||
character(*) :: assumed_shape_char(:)
|
||||
real :: ashape(:)
|
||||
class(t) :: polyarray(*)
|
||||
character(10) :: c(:)
|
||||
!ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
|
||||
call assumedsize(x)
|
||||
!ERROR: Scalar POINTER target may not be associated with a dummy argument 'x=' array
|
||||
!ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
|
||||
call assumedsize(p_scalar)
|
||||
!ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
|
||||
call assumedsize(p(1))
|
||||
!ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
|
||||
call assumedsize(ashape(1))
|
||||
!ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
|
||||
call polyassumedsize(polyarray(1))
|
||||
call charray(c(1:1)) ! not an error if character
|
||||
call charray(char_pointer(1)) ! not an error if character
|
||||
call charray(assumed_shape_char(1)) ! not an error if character
|
||||
call assumedsize(arr(1)) ! not an error if element in sequence
|
||||
call assumedrank(x) ! not an error
|
||||
call assumedtypeandsize(x) ! not an error
|
||||
|
|
|
@ -14,6 +14,9 @@ module m
|
|||
subroutine s03(p)
|
||||
real, pointer, intent(in) :: p(:)
|
||||
end subroutine
|
||||
subroutine s04(p)
|
||||
real, pointer :: p
|
||||
end subroutine
|
||||
|
||||
subroutine test
|
||||
!ERROR: CONTIGUOUS POINTER must be an array
|
||||
|
@ -30,6 +33,8 @@ module m
|
|||
call s03(a03) ! ok
|
||||
!ERROR: Actual argument associated with POINTER dummy argument 'p=' must also be POINTER unless INTENT(IN)
|
||||
call s02(a03)
|
||||
!ERROR: Actual argument associated with POINTER dummy argument 'p=' must also be POINTER unless INTENT(IN)
|
||||
call s04(a02(1))
|
||||
!ERROR: An array section with a vector subscript may not be a pointer target
|
||||
call s03(a03([1,2,4]))
|
||||
!ERROR: A coindexed object may not be a pointer target
|
||||
|
|
Loading…
Reference in a new issue