[flang] Fix CONTIGUOUS attribute for construct entities

[klausler]

Summary

Currently, the selector of a construct entity (e.g., ASSOCIATE(x=>a(1:20)))
is inheriting the CONTIGUOUS attribute from its associated variable
even if it has subscripts that make it noncontiguous (a(1:20:2)).
Add construct entities to the dynamic contiguity predicate instead.

[jeanPerier]

LGTM

flang/lib/Evaluate/check-expression.cpp

Result operator()(const semantics::Symbol &symbol) const {
     const auto &ultimate{symbol.GetUltimate()};
     if (ultimate.attrs().test(semantics::Attr::CONTIGUOUS)) {
       return true;
     } else if (ultimate.Rank() == 0) {
       // Extension: accept scalars as a degenerate case of
       // simple contiguity to allow their use in contexts like
       // data targets in pointer assignments with remapping.
       return true;
+    } else if (ultimate.has<semantics::AssocEntityDetails>()) {
+      return Base::operator()(ultimate); // use expr
     } else if (semantics::IsPointer(ultimate) ||
         semantics::IsAssumedShape(ultimate)) {
       return std::nullopt;
     } else if (const auto *details{
                    ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
       return !details->IsAssumedRank();
     } else {
       return Base::operator()(ultimate);

flang/lib/Semantics/resolve-names.cpp

if (std::optional<evaluate::DynamicType> type{expr.GetType()}) {
       Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US);
     }
   }
 }
 
 // If current selector is a variable, set some of its attributes on symbol.
 void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {
   Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
-  symbol.attrs() |= attrs &
-      Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::CONTIGUOUS};
+  symbol.attrs() |=
+      attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE};
   if (attrs.test(Attr::POINTER)) {
     SetImplicitAttr(symbol, Attr::TARGET);
   }
 }
 
 ConstructVisitor::Selector ConstructVisitor::ResolveSelector(
     const parser::Selector &x) {
   return common::visit(common::visitors{

flang/test/Evaluate/folding09.f90

 ! RUN: %python %S/test_folding.py %s %flang_fc1
-! Test folding of IS_CONTIGUOUS on simply contiguous items (9.5.4)
-! When IS_CONTIGUOUS() is constant, it's .TRUE.
+! Test folding of IS_CONTIGUOUS
 
 module m
   real, target :: hosted(2)
  contains
   function f()
     real, pointer, contiguous :: f(:)
     f => hosted
   end function
   subroutine test(arr1, arr2, arr3, mat, alloc)
     real, intent(in) :: arr1(:), arr2(10), mat(10, 10)
     real, intent(in), contiguous :: arr3(:)
     real, allocatable :: alloc(:)
     real :: scalar
-    logical, parameter :: test_isc01 = is_contiguous(0)
-    logical, parameter :: test_isc02 = is_contiguous(scalar)
-    logical, parameter :: test_isc03 = is_contiguous(scalar + scalar)
-    logical, parameter :: test_isc04 = is_contiguous([0, 1, 2])
-    logical, parameter :: test_isc05 = is_contiguous(arr1 + 1.0)
-    logical, parameter :: test_isc06 = is_contiguous(arr2)
-    logical, parameter :: test_isc07 = is_contiguous(mat)
-    logical, parameter :: test_isc08 = is_contiguous(mat(1:10,1))
-    logical, parameter :: test_isc09 = is_contiguous(arr2(1:10:1))
-    logical, parameter :: test_isc10 = is_contiguous(arr3)
-    logical, parameter :: test_isc11 = is_contiguous(f())
-    logical, parameter :: test_isc12 = is_contiguous(alloc)
+    integer(kind=merge(1,-1,       is_contiguous(0)))               t01
+    integer(kind=merge(1,-1,       is_contiguous(scalar)))          t02
+    integer(kind=merge(1,-1,       is_contiguous(scalar + scalar))) t03
+    integer(kind=merge(1,-1,       is_contiguous([0, 1, 2])))       t04
+    integer(kind=merge(1,-1,       is_contiguous(arr1 + 1.0)))      t05
+    integer(kind=merge(1,-1,       is_contiguous(arr2)))            t06
+    integer(kind=merge(1,-1,       is_contiguous(mat)))             t07
+    integer(kind=merge(1,-1,       is_contiguous(mat(1:10,1))))     t08
+    integer(kind=merge(1,-1,       is_contiguous(arr2(1:10:1))))    t09
+    integer(kind=merge(1,-1, .not. is_contiguous(arr2(1:10:2))))    t10
+    integer(kind=merge(1,-1,       is_contiguous(arr3)))            t11
+    integer(kind=merge(1,-1, .not. is_contiguous(arr3(1:10:2))))    t12
+    integer(kind=merge(1,-1,       is_contiguous(f())))             t13
+    integer(kind=merge(1,-1,       is_contiguous(alloc)))           t14
+    associate (x => arr2)
+      block
+        integer(kind=merge(1,-1,is_contiguous(x))) n
+      end block
+    end associate
+    associate (x => arr2(1:10:2))
+      block
+        integer(kind=merge(1,-1,.not. is_contiguous(x))) n
+      end block
+    end associate
+    associate (x => arr3)
+      block
+        integer(kind=merge(1,-1,is_contiguous(x))) n
+      end block
+    end associate
+    associate (x => arr3(1:10:2))
+      block
+        integer(kind=merge(1,-1,.not. is_contiguous(x))) n
+      end block
+    end associate
   end subroutine
 end module

flang/test/Lower/HLFIR/associate-construct.f90

 ! CHECK-LABEL: func.func @_QPassociate_var(
 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#1 {uniq_name = "_QFassociate_varEy"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
 ! CHECK:  fir.call @_FortranAioEndIoStatement
 ! CHECK-NEXT:  return
 
 subroutine associate_pointer(x)
   integer, pointer, contiguous :: x(:)
-  ! Check that "y" has the target and contiguous attributes.
+  ! Check that "y" has the target attribute.
   associate(y => x)
     print *, y
   end associate
 end subroutine
 ! CHECK-LABEL: func.func @_QPassociate_pointer(
 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
 ! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
 ! CHECK:  %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, index) -> (index, index, index)
 ! CHECK:  %[[VAL_6:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1>
-! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {fortran_attrs = #fir.var_attrs<contiguous, target>, uniq_name = "_QFassociate_pointerEy"} : (!fir.ptr<!fir.array<?xi32>>, !fir.shapeshift<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ptr<!fir.array<?xi32>>)
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFassociate_pointerEy"} : (!fir.ptr<!fir.array<?xi32>>, !fir.shapeshift<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ptr<!fir.array<?xi32>>)
 ! CHECK:  fir.call @_FortranAioEndIoStatement
 ! CHECK-NEXT:  return
 
 subroutine associate_allocatable(x)
   integer, allocatable :: x(:)
   associate(y => x)
     print *, y
   end associate

 end subroutine
 ! CHECK-LABEL: func.func @_QPassociate_pointer_section(
 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
 ! CHECK:  %[[VAL_4:.*]] = arith.constant 20 : index
 ! CHECK:  %[[VAL_6:.*]] = arith.constant 20 : index
 ! CHECK:  %[[VAL_8:.*]] = hlfir.designate %[[VAL_2]]{{.*}}
 ! CHECK:  %[[VAL_9:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
-! CHECK:  %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_8]](%[[VAL_9]]) {fortran_attrs = #fir.var_attrs<contiguous, target>, uniq_name = "_QFassociate_pointer_sectionEy"} : (!fir.ref<!fir.array<20xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<20xi32>>, !fir.ref<!fir.array<20xi32>>)
+! CHECK:  %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_8]](%[[VAL_9]]) {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFassociate_pointer_sectionEy"} : (!fir.ref<!fir.array<20xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<20xi32>>, !fir.ref<!fir.array<20xi32>>)
 ! CHECK:  fir.call @_FortranAioEndIoStatement
 ! CHECK-NEXT:  return