[flang] Improve contiguity checker for component references (#153222)
Component references to array values had a couple of TODOs in the
contiguity checker; implement them so that contiguity errors/warnings
and code generation are more accurate. Specifically, "a(1:1)%b" is
contiguous because there's a single element; "a(1:2)%b" is contiguous
when the type of "a" has but a single component. The case of multiple
components in the type is discontiguous when the array is known to have
multiple elements.
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 394a033..8931cbe 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1026,18 +1026,40 @@
if (x.base().Rank() == 0) {
return (*this)(x.GetLastSymbol());
} else {
- if (Result baseIsContiguous{(*this)(x.base())}) {
+ const DataRef &base{x.base()};
+ if (Result baseIsContiguous{(*this)(base)}) {
if (!*baseIsContiguous) {
return false;
+ } else {
+ bool sizeKnown{false};
+ if (auto constShape{GetConstantExtents(context_, x)}) {
+ sizeKnown = true;
+ if (GetSize(*constShape) <= 1) {
+ return true; // empty or singleton
+ }
+ }
+ const Symbol &last{base.GetLastSymbol()};
+ if (auto type{DynamicType::From(last)}) {
+ CHECK(type->category() == TypeCategory::Derived);
+ if (!type->IsPolymorphic()) {
+ const auto &derived{type->GetDerivedTypeSpec()};
+ if (const auto *scope{derived.scope()}) {
+ auto iter{scope->begin()};
+ if (++iter == scope->end()) {
+ return true; // type has but one component
+ } else if (sizeKnown) {
+ return false; // multiple components & array size is known > 1
+ }
+ }
+ }
+ }
}
- // TODO: should be true if base is contiguous and this is only
- // component, or when the base has at most one element
}
return std::nullopt;
}
}
Result operator()(const ComplexPart &x) const {
- // TODO: should be true when base is empty array, too
+ // TODO: should be true when base is empty array or singleton, too
return x.complex().Rank() == 0;
}
Result operator()(const Substring &x) const {
diff --git a/flang/test/Lower/components.f90 b/flang/test/Lower/components.f90
index 5afde4b..f0caddb 100644
--- a/flang/test/Lower/components.f90
+++ b/flang/test/Lower/components.f90
@@ -136,7 +136,7 @@
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[VAL_6]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX68656C6C6F"} : (!fir.ref<!fir.char<1,5>>, index) -> (!fir.ref<!fir.char<1,5>>, !fir.ref<!fir.char<1,5>>)
! CHECK: %[[VAL_8:.*]] = arith.constant 5 : index
! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_4]]#0{"c"} shape %[[VAL_3]] typeparams %[[VAL_8]] : (!fir.ref<!fir.array<10x!fir.type<_QFlhs_char_sectionTt
-! CHECK: hlfir.assign %[[VAL_7]]#0 to %[[VAL_9]] : !fir.ref<!fir.char<1,5>>, !fir.box<!fir.array<10x!fir.char<1,5>>>
+! CHECK: hlfir.assign %[[VAL_7]]#0 to %[[VAL_9]] : !fir.ref<!fir.char<1,5>>, !fir.ref<!fir.array<10x!fir.char<1,5>>>
! CHECK: return
! CHECK: }
@@ -163,7 +163,7 @@
! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_10]]) typeparams %[[VAL_8]] dummy_scope %[[VAL_2]] {uniq_name = "_QFrhs_char_sectionEc"} : (!fir.ref<!fir.array<10x!fir.char<1,10>>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.ref<!fir.array<10x!fir.char<1,10>>>, !fir.ref<!fir.array<10x!fir.char<1,10>>>)
! CHECK: %[[VAL_12:.*]] = arith.constant 10 : index
! CHECK: %[[VAL_13:.*]] = hlfir.designate %[[VAL_5]]#0{"c"} shape %[[VAL_4]] typeparams %[[VAL_12]] : (!fir.ref<!fir.array<10x!fir.type<_QFrhs_char_sectionTt
-! CHECK: hlfir.assign %[[VAL_13]] to %[[VAL_11]]#0 : !fir.box<!fir.array<10x!fir.char<1,10>>>, !fir.ref<!fir.array<10x!fir.char<1,10>>>
+! CHECK: hlfir.assign %[[VAL_13]] to %[[VAL_11]]#0 : !fir.ref<!fir.array<10x!fir.char<1,10>>>, !fir.ref<!fir.array<10x!fir.char<1,10>>>
! CHECK: return
! CHECK: }
@@ -192,7 +192,7 @@
! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_11]] typeparams %[[VAL_12]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX68656C6C6F"} : (!fir.ref<!fir.char<1,5>>, index) -> (!fir.ref<!fir.char<1,5>>, !fir.ref<!fir.char<1,5>>)
! CHECK: %[[VAL_14:.*]] = hlfir.elemental %[[VAL_4]] unordered : (!fir.shape<1>) -> !hlfir.expr<10xi32> {
! CHECK: ^bb0(%[[VAL_15:.*]]: index):
-! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_10]] (%[[VAL_15]]) typeparams %[[VAL_9]] : (!fir.box<!fir.array<10x!fir.char<1,10>>>, index, index) -> !fir.ref<!fir.char<1,10>>
+! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_10]] (%[[VAL_15]]) typeparams %[[VAL_9]] : (!fir.ref<!fir.array<10x!fir.char<1,10>>>, index, index) -> !fir.ref<!fir.char<1,10>>
! CHECK: %[[VAL_17:.*]] = arith.constant false
! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_9]] : (index) -> i64
diff --git a/flang/test/Semantics/contiguous02.f90 b/flang/test/Semantics/contiguous02.f90
new file mode 100644
index 0000000..6543ea9
--- /dev/null
+++ b/flang/test/Semantics/contiguous02.f90
@@ -0,0 +1,27 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+subroutine s1
+ type :: d1
+ real :: x
+ end type
+ type :: d2
+ type(d1) :: x
+ end type
+ type(d1), target :: a(5)
+ type(d2), target :: b(5)
+ real, pointer, contiguous :: c(:)
+ c => a%x ! okay, type has single component
+ c => b%x%x ! okay, types have single components
+end
+
+subroutine s2
+ type :: d1
+ real :: x, y
+ end type
+ type(d1), target :: b(5)
+ real, pointer, contiguous :: c(:)
+ !ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target
+ c => b%x
+ c => b(1:1)%x ! okay, one element
+ !ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target
+ c => b(1:2)%x
+end
