[flang] More precise CONTIGUOUS checking

A recent fix to avoid bogus errors with the CONTIGUOUS attribute caused
declaration checking to miss errors with applications of CONTIGUOUS to
names that are not variables.  Restore those error messages, and
add tests to ensure that the original problem remains fixed while
the recent regressions have been resolved.

Differential Revision: https://reviews.llvm.org/D151124
This commit is contained in:
Peter Klausler 2023-05-22 09:47:38 -07:00
parent 57c5c1ab2a
commit a8654b4457
No known key found for this signature in database
4 changed files with 60 additions and 15 deletions

View File

@ -58,6 +58,7 @@ private:
}
void CheckValue(const Symbol &, const DerivedTypeSpec *);
void CheckVolatile(const Symbol &, const DerivedTypeSpec *);
void CheckContiguous(const Symbol &);
void CheckPointer(const Symbol &);
void CheckPassArg(
const Symbol &proc, const Symbol *interface, const WithPassArg &);
@ -260,7 +261,9 @@ void CheckHelper::Check(const Symbol &symbol) {
!symbol.implicitAttrs().test(Attr::SAVE)) {
CheckExplicitSave(symbol);
}
const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
if (symbol.attrs().test(Attr::CONTIGUOUS)) {
CheckContiguous(symbol);
}
CheckGlobalName(symbol);
if (isDone) {
return; // following checks do not apply
@ -310,6 +313,7 @@ void CheckHelper::Check(const Symbol &symbol) {
"A dummy procedure of a pure subprogram must be pure"_err_en_US);
}
}
const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
if (type) { // Section 7.2, paragraph 7; C795
bool isChar{type->category() == DeclTypeSpec::Character};
bool canHaveAssumedParameter{(isChar && IsNamedConstant(symbol)) ||
@ -835,17 +839,6 @@ void CheckHelper::CheckObjectEntity(
"'%s' is a data object and may not be EXTERNAL"_err_en_US,
symbol.name());
}
if (symbol.attrs().test(Attr::CONTIGUOUS)) {
if ((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
evaluate::IsAssumedRank(symbol)) {
} else if (symbol.owner().IsDerivedType()) { // C752
messages_.Say(
"A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
} else { // C830
messages_.Say(
"CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank"_err_en_US);
}
}
}
void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
@ -1858,6 +1851,21 @@ void CheckHelper::CheckVolatile(const Symbol &symbol,
}
}
void CheckHelper::CheckContiguous(const Symbol &symbol) {
if (evaluate::IsVariable(symbol) &&
((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
evaluate::IsAssumedRank(symbol))) {
} else if (symbol.owner().IsDerivedType()) { // C752
messages_.Say(
"CONTIGUOUS component '%s' must be an array with the POINTER attribute"_err_en_US,
symbol.name());
} else {
messages_.Say(
"CONTIGUOUS entity '%s' must be an array pointer, assumed-shape, or assumed-rank"_err_en_US,
symbol.name());
}
}
void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
CheckConflicting(symbol, Attr::POINTER, Attr::TARGET);
CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE); // C751

View File

@ -19,12 +19,12 @@ module m
end subroutine
subroutine test
!ERROR: CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank
!ERROR: CONTIGUOUS entity 'a01' must be an array pointer, assumed-shape, or assumed-rank
real, pointer, contiguous :: a01 ! C830
real, pointer :: a02(:)
real, target :: a03(10)
real :: a04(10) ! not TARGET
!ERROR: CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank
!ERROR: CONTIGUOUS entity 'scalar' must be an array pointer, assumed-shape, or assumed-rank
real, contiguous :: scalar
call s01(a03) ! ok
!WARNING: Target of CONTIGUOUS pointer association is not known to be contiguous

View File

@ -0,0 +1,37 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
module m0
real, pointer, contiguous :: p1(:) ! ok
real, pointer :: p2(:)
end
module m
use m0
!ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p1'
contiguous p1
!ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p2'
contiguous p2
!ERROR: CONTIGUOUS entity 'x' must be an array pointer, assumed-shape, or assumed-rank
real, contiguous :: x
!ERROR: CONTIGUOUS entity 'scalar' must be an array pointer, assumed-shape, or assumed-rank
real, contiguous, pointer :: scalar
!ERROR: CONTIGUOUS entity 'allocatable' must be an array pointer, assumed-shape, or assumed-rank
real, contiguous, allocatable :: allocatable
contains
!ERROR: CONTIGUOUS entity 'func' must be an array pointer, assumed-shape, or assumed-rank
function func(ashape,arank) result(r)
real, contiguous :: ashape(:) ! ok
real, contiguous :: arank(..) ! ok
!ERROR: CONTIGUOUS entity 'r' must be an array pointer, assumed-shape, or assumed-rank
real :: r(10)
!ERROR: CONTIGUOUS entity 'r2' must be an array pointer, assumed-shape, or assumed-rank
real :: r2(10)
contiguous func
contiguous r
contiguous e
contiguous r2
!ERROR: CONTIGUOUS entity 'e' must be an array pointer, assumed-shape, or assumed-rank
entry e() result(r2)
end
function fp()
real, pointer, contiguous :: fp(:) ! ok
end
end

View File

@ -12,7 +12,7 @@ subroutine s()
!ERROR: 'pointerallocatablefield' may not have both the POINTER and ALLOCATABLE attributes
real, pointer, allocatable :: pointerAllocatableField
real, dimension(:), contiguous, pointer :: goodContigField
!ERROR: A CONTIGUOUS component must be an array with the POINTER attribute
!ERROR: CONTIGUOUS component 'badcontigfield' must be an array with the POINTER attribute
real, dimension(:), contiguous, allocatable :: badContigField
character :: charField * 3
!ERROR: A length specifier cannot be used to declare the non-character entity 'realfield'