[flang-commits] [flang] a8654b4 - [flang] More precise CONTIGUOUS checking
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon May 22 12:03:02 PDT 2023
Author: Peter Klausler
Date: 2023-05-22T12:02:50-07:00
New Revision: a8654b44579d35ffaed0634eaf76cbceae6748f1
URL: https://github.com/llvm/llvm-project/commit/a8654b44579d35ffaed0634eaf76cbceae6748f1
DIFF: https://github.com/llvm/llvm-project/commit/a8654b44579d35ffaed0634eaf76cbceae6748f1.diff
LOG: [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
Added:
flang/test/Semantics/contiguous01.f90
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/test/Semantics/call07.f90
flang/test/Semantics/resolve90.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 1b9a747501edc..1202ccfc4e3bb 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -58,6 +58,7 @@ class CheckHelper {
}
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
diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
index 71229875262b7..ff372206fe824 100644
--- a/flang/test/Semantics/call07.f90
+++ b/flang/test/Semantics/call07.f90
@@ -19,12 +19,12 @@ subroutine s04(p)
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
diff --git a/flang/test/Semantics/contiguous01.f90 b/flang/test/Semantics/contiguous01.f90
new file mode 100644
index 0000000000000..77820b94bb654
--- /dev/null
+++ b/flang/test/Semantics/contiguous01.f90
@@ -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
diff --git a/flang/test/Semantics/resolve90.f90 b/flang/test/Semantics/resolve90.f90
index 12467341a97e6..16cb641adc663 100644
--- a/flang/test/Semantics/resolve90.f90
+++ b/flang/test/Semantics/resolve90.f90
@@ -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'
More information about the flang-commits
mailing list