[flang] Skip creating AggregateStores for common block associated aggregates

[jpenix-quic]

Summary

Previously, AggregateStores were created for aggregates associated with common
blocks. As a) AggregateStoreMap uses scope and offset information to search for
aggregate stores and b) variables related to common blocks have their
offsets set relative to the common block itself, if there were multiple
equivalences and at least one involved variables defined in a common block there
was an opportunity for the scope/offset pairs to match between distinct
aggregate stores. As a result, entries in AggregateStoreMap could collide,
resulting in incorrect stores being returned for a particular variable.

To prevent these collisions, skip creating AggregateStores for aggregates which
are associated with common blocks. This information was already unused as
aggregates associated with common blocks are handled by instantiateCommon.

Fixes https://github.com/llvm/llvm-project/issues/57749

[jeanPerier]

Thanks for identifying the issue and submitting this patch!

As you mention, AggregateStore are actually not used for common blocks since "instantiateCommon" is used even if they are equivalenced variables in the common block. They are meant to deal with storages that are interlaced because of an equivalence, but if the variables are part of a common, all this information is already available.

So, I think that instead of modifying the AggregateStoreKeys so that "common block" AggregateStore stores can be added without overriding non common block AggregateStores, and later be unused, I think it might be simpler to simply not build the AggregateStore for common blocks (see inlined suggestion).

flang/lib/Lower/PFTBuilder.cpp

1326–1333

I think you could maybe simply continue here if first belong to a common block in order to not build aggregate stores for common blocks.

[jpenix-quic]

Implement @jeanPerier's suggestion and update the title/summary accordingly. Also fixed "equivaleneced" -> "equivalenced" in the test comment.

[jpenix-quic]

flang/lib/Lower/PFTBuilder.cpp

1326–1333

This is indeed much simpler and tested ok for me. Thanks!

[jeanPerier]

Thanks for fixing the issue !

flang/lib/Lower/PFTBuilder.cpp

if (analyzedScopes.find(&scope) != analyzedScopes.end())
       return;
 
     analyzedScopes.insert(&scope);
     std::list<std::list<semantics::SymbolRef>> aggregates =
         Fortran::semantics::GetStorageAssociations(scope);
     for (std::list<semantics::SymbolRef> aggregate : aggregates) {
       const Fortran::semantics::Symbol *aggregateSym = nullptr;
       bool isGlobal = false;
       const semantics::Symbol &first = *aggregate.front();
+      // Skip aggregates related to common blocks as they will be handled by
+      // instantiateCommon and the aggregate store information will not be used.
+      // Additionally, the AggregateStoreKeys for common block related aggregate
+      // stores can collide with non common block ones, potentially resulting in
+      // incorrect stores being used.
+      if (lower::definedInCommonBlock(first))
+        continue;
       std::size_t start = first.offset();
       std::size_t end = first.offset() + first.size();
       const Fortran::semantics::Symbol *namingSym = nullptr;
       for (semantics::SymbolRef symRef : aggregate) {
         const semantics::Symbol &sym = *symRef;
         aliasSyms.insert(&sym);
         if (sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated)) {
           aggregateSym = &sym;

flang/test/Lower/equivalence-2.f90

! CHECK-LABEL: @_QPeq_and_entry_bar()
 
   ! CHECK-DAG: %[[xOffset:.*]] = arith.constant 0 : index
   ! CHECK-DAG: %[[xAddr:.*]] = fir.coordinate_of %[[xi]], %[[xOffset]] : (!fir.ref<!fir.array<8xi8>>, index) -> !fir.ref<i8>
   ! CHECK-DAG: %[[x:.*]] = fir.convert %[[xAddr]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<2xf32>>
   ! CHECK-NOT: fir.call @_QPfoo1
   ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ptr<!fir.array<2xf32>>) -> !fir.ref<!fir.array<2xf32>>
   ! CHECK: %[[iCast:.*]] = fir.convert %[[i]] : (!fir.ptr<i32>) -> !fir.ref<i32>
   ! CHECK: fir.call @_QPfoo2(%[[xCast]], %[[iCast]]) : (!fir.ref<!fir.array<2xf32>>, !fir.ref<i32>) -> ()
+
+
+! Check that cases where equivalenced local variables and common blocks will
+! share the same offset use the correct stores
+! CHECK-LABEL: @_QPeq_and_comm_same_offset()
+subroutine eq_and_comm_same_offset
+  real common_arr1(133),common_arr2(133)
+  common /my_common_block/ common_arr1,common_arr2
+  real arr1(133),arr2(133)
+  real arr3(133,133),arr4(133,133)
+  equivalence(arr1,common_arr1),(arr2,common_arr2)
+  equivalence(arr3,arr4)
+
+  ! CHECK: %[[arr4Store:.*]] = fir.alloca !fir.array<70756xi8> {uniq_name = "_QFeq_and_comm_same_offsetEarr3"}
+  ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QBmy_common_block) : !fir.ref<!fir.array<1064xi8>>
+  ! CHECK: %[[mcbCast:.*]] = fir.convert %[[mcbAddr]] : (!fir.ref<!fir.array<1064xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+  ! CHECK: %[[mcbCoor:.*]] = fir.coordinate_of %[[mcbCast]], %[[c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  ! CHECK: %[[mcbCoorCast:.*]] = fir.convert %[[mcbCoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<133xf32>>
+  ! CHECK: %[[c1:.*]] = arith.constant 0 : index
+  ! CHECK: %[[arr4Addr:.*]] = fir.coordinate_of %[[arr4Store]], %[[c1]] : (!fir.ref<!fir.array<70756xi8>>, index) -> !fir.ref<i8>
+  ! CHECK: %[[arr4Cast:.*]] = fir.convert %[[arr4Addr]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<133x133xf32>>
+
+  arr1(1) = 1
+  ! CHECK:%[[mcbFinalAddr:.*]] = fir.coordinate_of %[[mcbCoorCast]], %{{.*}} : (!fir.ptr<!fir.array<133xf32>>, i64) -> !fir.ref<f32>
+  ! CHECK:fir.store %{{.*}} to %[[mcbFinalAddr]] : !fir.ref<f32>
+
+  arr4(1,1) = 2
+  ! CHECK: %[[arr4FinalAddr:.*]] = fir.coordinate_of %[[arr4Cast]], %{{.*}}, %{{.*}} : (!fir.ptr<!fir.array<133x133xf32>>, i64, i64) -> !fir.ref<f32>
+  ! CHECK: fir.store %{{.*}} to %[[arr4FinalAddr]] : !fir.ref<f32>
+end subroutine