Index: flang/include/flang/Lower/ConvertVariable.h =================================================================== --- flang/include/flang/Lower/ConvertVariable.h +++ flang/include/flang/Lower/ConvertVariable.h @@ -40,7 +40,8 @@ /// when lowering a scope containing equivalences (aliases). It must only be /// owned by the code lowering a scope and provided to instantiateVariable. using AggregateStoreKey = - std::tuple<const Fortran::semantics::Scope *, std::size_t>; + std::tuple<const Fortran::semantics::Scope *, + const Fortran::semantics::Symbol *, std::size_t>; using AggregateStoreMap = llvm::DenseMap<AggregateStoreKey, mlir::Value>; /// Instantiate variable \p var and add it to \p symMap. Index: flang/include/flang/Lower/PFTBuilder.h =================================================================== --- flang/include/flang/Lower/PFTBuilder.h +++ flang/include/flang/Lower/PFTBuilder.h @@ -417,14 +417,16 @@ struct AggregateStore { AggregateStore(Interval &&interval, const Fortran::semantics::Symbol &namingSym, + const Fortran::semantics::Symbol *commonSymbol, bool isGlobal = false) : interval{std::move(interval)}, namingSymbol{&namingSym}, - isGlobalAggregate{isGlobal} {} + commonSymbol{commonSymbol}, isGlobalAggregate{isGlobal} {} AggregateStore(const semantics::Symbol &initialValueSym, - const semantics::Symbol &namingSym, bool isGlobal = false) + const semantics::Symbol &namingSym, + const semantics::Symbol *commonSymbol, bool isGlobal = false) : interval{initialValueSym.offset(), initialValueSym.size()}, namingSymbol{&namingSym}, initialValueSymbol{&initialValueSym}, - isGlobalAggregate{isGlobal} {}; + commonSymbol{commonSymbol}, isGlobalAggregate{isGlobal} {}; bool isGlobal() const { return isGlobalAggregate; } /// Get offset of the aggregate inside its scope. @@ -433,6 +435,8 @@ const semantics::Symbol *getInitialValueSymbol() const { return initialValueSymbol; } + /// Returns common block symbol associated with the aggregate store if any. + const semantics::Symbol *getCommonSymbol() const { return commonSymbol; } /// Returns the symbol that gives its name to the aggregate. const semantics::Symbol &getNamingSymbol() const { return *namingSymbol; } /// Scope to which the aggregates belongs to. @@ -445,6 +449,8 @@ const semantics::Symbol *namingSymbol; /// Compiler generated symbol with the aggregate initial value if any. const semantics::Symbol *initialValueSymbol = nullptr; + /// Common block symbol associated with the aggregate store if any. + const semantics::Symbol *commonSymbol; /// Is this a global aggregate ? bool isGlobalAggregate; }; @@ -499,6 +505,17 @@ var); } + const Fortran::semantics::Symbol *getCommonSymbol() const { + return std::visit( + common::visitors{ + [](const Nominal &x) { + return Fortran::semantics::FindCommonBlockContaining( + x.symbol->GetUltimate()); + }, + [](const AggregateStore &agg) { return agg.getCommonSymbol(); }}, + var); + } + bool isHeapAlloc() const { if (auto *s = std::get_if<Nominal>(&var)) return s->heapAlloc; Index: flang/lib/Lower/ConvertVariable.cpp =================================================================== --- flang/lib/Lower/ConvertVariable.cpp +++ flang/lib/Lower/ConvertVariable.cpp @@ -690,7 +690,8 @@ const Fortran::lower::pft::Variable &var, mlir::Value aggregateStore) { std::size_t off = var.getAggregateStore().getOffset(); - Fortran::lower::AggregateStoreKey key = {var.getOwningScope(), off}; + Fortran::lower::AggregateStoreKey key = {var.getOwningScope(), + var.getCommonSymbol(), off}; storeMap[key] = aggregateStore; } @@ -699,8 +700,8 @@ static mlir::Value getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap, const Fortran::lower::pft::Variable &alias) { - Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(), - alias.getAlias()}; + Fortran::lower::AggregateStoreKey key = { + alias.getOwningScope(), alias.getCommonSymbol(), alias.getAlias()}; auto iter = storeMap.find(key); assert(iter != storeMap.end()); return iter->second; Index: flang/lib/Lower/PFTBuilder.cpp =================================================================== --- flang/lib/Lower/PFTBuilder.cpp +++ flang/lib/Lower/PFTBuilder.cpp @@ -1327,6 +1327,7 @@ std::size_t start = first.offset(); std::size_t end = first.offset() + first.size(); const Fortran::semantics::Symbol *namingSym = nullptr; + const Fortran::semantics::Symbol *commonSym = nullptr; for (semantics::SymbolRef symRef : aggregate) { const semantics::Symbol &sym = *symRef; aliasSyms.insert(&sym); @@ -1338,15 +1339,21 @@ end = std::max(sym.offset() + sym.size(), end); if (!namingSym || (sym.name() < namingSym->name())) namingSym = &sym; + if (!commonSym) { + if (const Fortran::semantics::Symbol *common = + Fortran::semantics::FindCommonBlockContaining( + sym.GetUltimate())) + commonSym = common; + } } } assert(namingSym && "must contain at least one user symbol"); if (!aggregateSym) { stores.emplace_back( Fortran::lower::pft::Variable::Interval{start, end - start}, - *namingSym, isGlobal); + *namingSym, commonSym, isGlobal); } else { - stores.emplace_back(*aggregateSym, *namingSym, isGlobal); + stores.emplace_back(*aggregateSym, *namingSym, commonSym, isGlobal); } } } Index: flang/test/Lower/equivalence-2.f90 =================================================================== --- flang/test/Lower/equivalence-2.f90 +++ flang/test/Lower/equivalence-2.f90 @@ -97,3 +97,34 @@ ! 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 equivaleneced 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