[flang-commits] [flang] [flang] Set SAVE attribute for EQUIVALENCEd symbols consistently. (PR #67078)
Slava Zakharin via flang-commits
flang-commits at lists.llvm.org
Fri Sep 22 16:04:49 PDT 2023
https://github.com/vzakhari updated https://github.com/llvm/llvm-project/pull/67078
>From 977255f56bd87b545197b599eab7c6436fddabed Mon Sep 17 00:00:00 2001
From: Slava Zakharin <szakharin at nvidia.com>
Date: Thu, 21 Sep 2023 16:32:08 -0700
Subject: [PATCH 1/3] [flang] Access host associated equivalences via global
aggregate storage.
Example:
```
subroutine global_sub()
integer, dimension(4) :: iarr4=(/1,2,3,4/)
integer, dimension(4) :: jarr4
equivalence(iarr4,jarr4)
call sub1
print *, iarr4
contains
subroutine sub1
iarr4=jarr4((/4:1:-1/))
end subroutine sub1
end subroutine global_sub
```
`iarr4` and `jarr4` are equivalenced via a global aggregate storage,
but the references inside `sub1` are lowered differently.
`iarr4` is accessed via the global aggregate storage, while `jarr4`
is accessed via the argument tuple. This confuses the FIR alias analysis,
that claims that a host associated entity cannot alias with a global
(if they have different source and do not have Target/Pointer
attributes deduced by the alias analysis).
I am not convinced that there is an issue in the alias analysis yet.
I think we'd better lower the accesses uniformly, i.e. if one variable
from an equivalence is lowered via the global aggregate storage, then
any other variable from this equivalence should be lowered the same way
(even if they are used via host association). This patch tries to make
the lowering consistent.
Note that in the above example `iarr4` symbol is global, while
`jarr4` is not. Maybe this issue could have been fixed before
the lowering by uniformly marking all symbols from the equivalence
as globals, so comments are very welcome.
---
flang/lib/Lower/HostAssociations.cpp | 37 ++++-
.../Lower/equivalence-with-host-assoc.f90 | 140 ++++++++++++++++++
2 files changed, 171 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Lower/equivalence-with-host-assoc.f90
diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index aa0cc50b6347aec..8576639c04807a9 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -507,13 +507,38 @@ void Fortran::lower::HostAssociations::addSymbolsToBind(
assert(tupleSymbols.empty() && globalSymbols.empty() &&
"must be initially empty");
this->hostScope = &hostScope;
+
+ // Collect integer offsets of all global aggregate storages
+ // in the host scope.
+ llvm::DenseSet<std::size_t> globalAggregateStoreOffests;
+ for (auto &hostVariable : pft::getScopeVariableList(hostScope))
+ if (hostVariable.isAggregateStore() && hostVariable.isGlobal())
+ globalAggregateStoreOffests.insert(
+ hostVariable.getAggregateStore().getOffset());
+
+ // Look for aliases (EQUIVALENCE variables) that are associated
+ // with the global aggregate storages in the host scope.
+ // If such an alias is referenced by the internal procedure,
+ // its symbol might not be global, but we'd rather access
+ // it via the global aggregate storage than via the argument tuple.
+ for (auto &hostVariable : pft::getScopeVariableList(hostScope))
+ if (hostVariable.hasSymbol() && hostVariable.isAlias() &&
+ globalAggregateStoreOffests.contains(hostVariable.getAliasOffset())) {
+ const Fortran::semantics::Symbol *sym =
+ &hostVariable.getSymbol().GetUltimate();
+ if (symbols.contains(sym))
+ globalSymbols.insert(sym);
+ }
+
for (const auto *s : symbols)
- if (Fortran::lower::symbolIsGlobal(*s))
- // The ultimate symbol is stored here so that global symbols from the
- // host scope can later be searched in this set.
- globalSymbols.insert(&s->GetUltimate());
- else
- tupleSymbols.insert(s);
+ if (!globalSymbols.contains(&s->GetUltimate())) {
+ if (Fortran::lower::symbolIsGlobal(*s))
+ // The ultimate symbol is stored here so that global symbols from the
+ // host scope can later be searched in this set.
+ globalSymbols.insert(&s->GetUltimate());
+ else
+ tupleSymbols.insert(s);
+ }
}
void Fortran::lower::HostAssociations::hostProcedureBindings(
diff --git a/flang/test/Lower/equivalence-with-host-assoc.f90 b/flang/test/Lower/equivalence-with-host-assoc.f90
new file mode 100644
index 000000000000000..f9ac2692fd9c8a3
--- /dev/null
+++ b/flang/test/Lower/equivalence-with-host-assoc.f90
@@ -0,0 +1,140 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s --check-prefixes=FIR
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s --check-prefixes=HLFIR
+
+subroutine test1()
+ integer :: i1 = 1
+ integer :: j1
+ equivalence(i1,j1)
+contains
+ subroutine inner
+ i1 = j1
+ end subroutine inner
+end subroutine test1
+! FIR-LABEL: func.func @_QFtest1Pinner() attributes {fir.internal_proc} {
+! FIR: %[[VAL_0:.*]] = fir.address_of(@_QFtest1Ei1) : !fir.ref<!fir.array<1xi32>>
+! FIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<1xi32>>) -> !fir.ref<!fir.array<4xi8>>
+! FIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_5:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_5]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ptr<i32>
+! FIR: fir.store %[[VAL_8]] to %[[VAL_4]] : !fir.ptr<i32>
+! FIR: return
+! FIR: }
+
+! HLFIR-LABEL: func.func @_QFtest1Pinner() attributes {fir.internal_proc} {
+! HLFIR: %[[VAL_0:.*]] = fir.address_of(@_QFtest1Ei1) : !fir.ref<!fir.array<1xi32>>
+! HLFIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<1xi32>>) -> !fir.ref<!fir.array<4xi8>>
+! HLFIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFtest1Ei1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_6:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QFtest1Ej1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_10:.*]] = fir.load %[[VAL_9]]#0 : !fir.ptr<i32>
+! HLFIR: hlfir.assign %[[VAL_10]] to %[[VAL_5]]#0 : i32, !fir.ptr<i32>
+! HLFIR: return
+! HLFIR: }
+
+module test2
+ real :: f1, f2
+ equivalence(f1, f2)
+contains
+ subroutine host
+ real :: f1 = 1
+ real :: f2
+ equivalence(f1, f2)
+ contains
+ subroutine inner
+ f1 = f2
+ end subroutine inner
+ end subroutine host
+end module test2
+! FIR-LABEL: func.func @_QMtest2FhostPinner() attributes {fir.internal_proc} {
+! FIR: %[[VAL_0:.*]] = fir.address_of(@_QMtest2FhostEf1) : !fir.ref<!fir.array<1xi32>>
+! FIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<1xi32>>) -> !fir.ref<!fir.array<4xi8>>
+! FIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<f32>
+! FIR: %[[VAL_5:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_5]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<i8>) -> !fir.ptr<f32>
+! FIR: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ptr<f32>
+! FIR: fir.store %[[VAL_8]] to %[[VAL_4]] : !fir.ptr<f32>
+! FIR: return
+! FIR: }
+
+! HLFIR-LABEL: func.func @_QMtest2FhostPinner() attributes {fir.internal_proc} {
+! HLFIR: %[[VAL_0:.*]] = fir.address_of(@_QMtest2FhostEf1) : !fir.ref<!fir.array<1xi32>>
+! HLFIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<1xi32>>) -> !fir.ref<!fir.array<4xi8>>
+! HLFIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<f32>
+! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QMtest2FhostEf1"} : (!fir.ptr<f32>) -> (!fir.ptr<f32>, !fir.ptr<f32>)
+! HLFIR: %[[VAL_6:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ptr<f32>
+! HLFIR: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QMtest2FhostEf2"} : (!fir.ptr<f32>) -> (!fir.ptr<f32>, !fir.ptr<f32>)
+! HLFIR: %[[VAL_19:.*]] = fir.load %[[VAL_9]]#0 : !fir.ptr<f32>
+! HLFIR: hlfir.assign %[[VAL_19]] to %[[VAL_5]]#0 : f32, !fir.ptr<f32>
+! HLFIR: return
+! HLFIR: }
+
+subroutine test3()
+ integer :: i1 = 1
+ integer :: j1, k1
+ common /blk/ k1
+ equivalence(i1,j1,k1)
+contains
+ subroutine inner
+ i1 = j1 + k1
+ end subroutine inner
+end subroutine test3
+! FIR-LABEL: func.func @_QFtest3Pinner() attributes {fir.internal_proc} {
+! FIR: %[[VAL_0:.*]] = fir.address_of(@blk_) : !fir.ref<tuple<i32>>
+! FIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! FIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! FIR: %[[VAL_6:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_9:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! FIR: %[[VAL_10:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_10]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_13:.*]] = fir.load %[[VAL_8]] : !fir.ptr<i32>
+! FIR: %[[VAL_14:.*]] = fir.load %[[VAL_12]] : !fir.ptr<i32>
+! FIR: %[[VAL_15:.*]] = arith.addi %[[VAL_13]], %[[VAL_14]] : i32
+! FIR: fir.store %[[VAL_15]] to %[[VAL_4]] : !fir.ptr<i32>
+! FIR: return
+! FIR: }
+
+! HLFIR-LABEL: func.func @_QFtest3Pinner() attributes {fir.internal_proc} {
+! HLFIR: %[[VAL_0:.*]] = fir.address_of(@blk_) : !fir.ref<tuple<i32>>
+! HLFIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! HLFIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFtest3Ei1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! HLFIR: %[[VAL_7:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_6]], %[[VAL_7]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {uniq_name = "_QFtest3Ej1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_11:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! HLFIR: %[[VAL_12:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_11]], %[[VAL_12]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_14]] {uniq_name = "_QFtest3Ek1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_16:.*]] = fir.load %[[VAL_10]]#0 : !fir.ptr<i32>
+! HLFIR: %[[VAL_17:.*]] = fir.load %[[VAL_15]]#0 : !fir.ptr<i32>
+! HLFIR: %[[VAL_18:.*]] = arith.addi %[[VAL_16]], %[[VAL_17]] : i32
+! HLFIR: hlfir.assign %[[VAL_18]] to %[[VAL_5]]#0 : i32, !fir.ptr<i32>
+! HLFIR: return
+! HLFIR: }
>From 1c776a7e93d8a1b532707718149fcaa59139949d Mon Sep 17 00:00:00 2001
From: Slava Zakharin <szakharin at nvidia.com>
Date: Fri, 22 Sep 2023 13:51:09 -0700
Subject: [PATCH 2/3] Reworked the fix by setting SAVE attribute for
EQUIVALENCE closure.
---
flang/lib/Lower/HostAssociations.cpp | 36 ++----------
flang/lib/Semantics/resolve-names-utils.cpp | 12 ++--
flang/lib/Semantics/resolve-names.cpp | 2 +-
.../Lower/equivalence-with-host-assoc.f90 | 55 +++++++++++++++++++
flang/test/Semantics/data13.f90 | 4 +-
flang/test/Semantics/offsets03.f90 | 16 +++---
flang/test/Semantics/resolve121.f90 | 45 +++++++++++++++
7 files changed, 123 insertions(+), 47 deletions(-)
create mode 100644 flang/test/Semantics/resolve121.f90
diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index 8576639c04807a9..a62f7a7e99b6ffd 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -507,37 +507,13 @@ void Fortran::lower::HostAssociations::addSymbolsToBind(
assert(tupleSymbols.empty() && globalSymbols.empty() &&
"must be initially empty");
this->hostScope = &hostScope;
-
- // Collect integer offsets of all global aggregate storages
- // in the host scope.
- llvm::DenseSet<std::size_t> globalAggregateStoreOffests;
- for (auto &hostVariable : pft::getScopeVariableList(hostScope))
- if (hostVariable.isAggregateStore() && hostVariable.isGlobal())
- globalAggregateStoreOffests.insert(
- hostVariable.getAggregateStore().getOffset());
-
- // Look for aliases (EQUIVALENCE variables) that are associated
- // with the global aggregate storages in the host scope.
- // If such an alias is referenced by the internal procedure,
- // its symbol might not be global, but we'd rather access
- // it via the global aggregate storage than via the argument tuple.
- for (auto &hostVariable : pft::getScopeVariableList(hostScope))
- if (hostVariable.hasSymbol() && hostVariable.isAlias() &&
- globalAggregateStoreOffests.contains(hostVariable.getAliasOffset())) {
- const Fortran::semantics::Symbol *sym =
- &hostVariable.getSymbol().GetUltimate();
- if (symbols.contains(sym))
- globalSymbols.insert(sym);
- }
-
for (const auto *s : symbols)
- if (!globalSymbols.contains(&s->GetUltimate())) {
- if (Fortran::lower::symbolIsGlobal(*s))
- // The ultimate symbol is stored here so that global symbols from the
- // host scope can later be searched in this set.
- globalSymbols.insert(&s->GetUltimate());
- else
- tupleSymbols.insert(s);
+ if (Fortran::lower::symbolIsGlobal(*s)) {
+ // The ultimate symbol is stored here so that global symbols from the
+ // host scope can later be searched in this set.
+ globalSymbols.insert(&s->GetUltimate());
+ } else {
+ tupleSymbols.insert(s);
}
}
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 2f8e5777c529020..ebc7aab3744d540 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -353,17 +353,17 @@ Bound ArraySpecAnalyzer::GetBound(const parser::SpecificationExpr &x) {
return Bound{std::move(expr)};
}
-// If SAVE is set on src, set it on all members of dst
+// If src is SAVE (explicitly or implicitly),
+// set SAVE attribute on all members of dst.
static void PropagateSaveAttr(
const EquivalenceObject &src, EquivalenceSet &dst) {
- if (src.symbol.attrs().test(Attr::SAVE)) {
- bool isImplicit{src.symbol.implicitAttrs().test(Attr::SAVE)};
+ if (IsSaved(src.symbol)) {
for (auto &obj : dst) {
if (!obj.symbol.attrs().test(Attr::SAVE)) {
obj.symbol.attrs().set(Attr::SAVE);
- if (isImplicit) {
- obj.symbol.implicitAttrs().set(Attr::SAVE);
- }
+ // If the other equivalenced symbol itself is not SAVE,
+ // then adding SAVE here implies that it has to be implicit.
+ obj.symbol.implicitAttrs().set(Attr::SAVE);
}
}
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 60a604bd0888838..23a0370b930aecd 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2390,7 +2390,7 @@ Symbol &ScopeHandler::MakeHostAssocSymbol(
// These attributes can be redundantly reapplied without error
// on the host-associated name, at most once (C815).
symbol.implicitAttrs() =
- symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
+ symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::SAVE};
symbol.flags() = hostSymbol.flags();
return symbol;
}
diff --git a/flang/test/Lower/equivalence-with-host-assoc.f90 b/flang/test/Lower/equivalence-with-host-assoc.f90
index f9ac2692fd9c8a3..e69b08106aa6d3d 100644
--- a/flang/test/Lower/equivalence-with-host-assoc.f90
+++ b/flang/test/Lower/equivalence-with-host-assoc.f90
@@ -138,3 +138,58 @@ end subroutine test3
! HLFIR: hlfir.assign %[[VAL_18]] to %[[VAL_5]]#0 : i32, !fir.ptr<i32>
! HLFIR: return
! HLFIR: }
+
+subroutine test4()
+ integer :: i1
+ integer :: j1, k1
+ common /blk/ k1
+ equivalence(i1,j1,k1)
+contains
+ subroutine inner
+ i1 = j1 + k1
+ end subroutine inner
+end subroutine test4
+! FIR-LABEL: func.func @_QFtest4Pinner() attributes {fir.internal_proc} {
+! FIR: %[[VAL_0:.*]] = fir.address_of(@blk_) : !fir.ref<tuple<i32>>
+! FIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! FIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! FIR: %[[VAL_6:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_9:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! FIR: %[[VAL_10:.*]] = arith.constant 0 : index
+! FIR: %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_10]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! FIR: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! FIR: %[[VAL_13:.*]] = fir.load %[[VAL_8]] : !fir.ptr<i32>
+! FIR: %[[VAL_14:.*]] = fir.load %[[VAL_12]] : !fir.ptr<i32>
+! FIR: %[[VAL_15:.*]] = arith.addi %[[VAL_13]], %[[VAL_14]] : i32
+! FIR: fir.store %[[VAL_15]] to %[[VAL_4]] : !fir.ptr<i32>
+! FIR: return
+! FIR: }
+
+! HLFIR-LABEL: func.func @_QFtest4Pinner() attributes {fir.internal_proc} {
+! HLFIR: %[[VAL_0:.*]] = fir.address_of(@blk_) : !fir.ref<tuple<i32>>
+! HLFIR: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! HLFIR: %[[VAL_2:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFtest4Ei1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! HLFIR: %[[VAL_7:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_6]], %[[VAL_7]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {uniq_name = "_QFtest4Ej1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_11:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<tuple<i32>>) -> !fir.ref<!fir.array<?xi8>>
+! HLFIR: %[[VAL_12:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_11]], %[[VAL_12]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! HLFIR: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (!fir.ref<i8>) -> !fir.ptr<i32>
+! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_14]] {uniq_name = "_QFtest4Ek1"} : (!fir.ptr<i32>) -> (!fir.ptr<i32>, !fir.ptr<i32>)
+! HLFIR: %[[VAL_16:.*]] = fir.load %[[VAL_10]]#0 : !fir.ptr<i32>
+! HLFIR: %[[VAL_17:.*]] = fir.load %[[VAL_15]]#0 : !fir.ptr<i32>
+! HLFIR: %[[VAL_18:.*]] = arith.addi %[[VAL_16]], %[[VAL_17]] : i32
+! HLFIR: hlfir.assign %[[VAL_18]] to %[[VAL_5]]#0 : i32, !fir.ptr<i32>
+! HLFIR: return
+! HLFIR: }
diff --git a/flang/test/Semantics/data13.f90 b/flang/test/Semantics/data13.f90
index 75e572e0dbc2ffa..bed61694c94bb77 100644
--- a/flang/test/Semantics/data13.f90
+++ b/flang/test/Semantics/data13.f90
@@ -3,10 +3,10 @@
! initialization produces a combined initializer, with explicit
! initialization overriding any default component initialization.
! CHECK: .F18.0, SAVE (CompilerCreated) size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8 init:[INTEGER(4)::456_4,234_4]
-! CHECK: ja (InDataStmt) size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
+! CHECK: ja, SAVE (InDataStmt) size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
! CHECK-NOT: x0, SAVE size=8 offset=8: ObjectEntity type: TYPE(t1) init:t1(m=123_4,n=234_4)
! CHECK: x1 size=8 offset=16: ObjectEntity type: TYPE(t1) init:t1(m=345_4,n=234_4)
-! CHECK: x2 size=8 offset=0: ObjectEntity type: TYPE(t1)
+! CHECK: x2, SAVE size=8 offset=0: ObjectEntity type: TYPE(t1)
! CHECK-NOT: x3a, SAVE size=8 offset=24: ObjectEntity type: TYPE(t3) init:t3(t2=t2(k=567_4),j=0_4)
! CHECK: x3b size=8 offset=32: ObjectEntity type: TYPE(t3) init:t3(k=567_4,j=678_4)
! CHECK: Equivalence Sets: (x2,ja(1)) (.F18.0,x2)
diff --git a/flang/test/Semantics/offsets03.f90 b/flang/test/Semantics/offsets03.f90
index 7416b6d3f37d478..c8c1abebb5d3ce3 100644
--- a/flang/test/Semantics/offsets03.f90
+++ b/flang/test/Semantics/offsets03.f90
@@ -5,19 +5,19 @@
! a1 depends on a2 depends on a3
module ma
real :: a1(10), a2(10), a3(10)
- equivalence(a1, a2(3)) !CHECK: a1, PUBLIC size=40 offset=20:
- equivalence(a2, a3(4)) !CHECK: a2, PUBLIC size=40 offset=12:
- !CHECK: a3, PUBLIC size=40 offset=0:
+ equivalence(a1, a2(3)) !CHECK: a1, PUBLIC, SAVE size=40 offset=20:
+ equivalence(a2, a3(4)) !CHECK: a2, PUBLIC, SAVE size=40 offset=12:
+ !CHECK: a3, PUBLIC, SAVE size=40 offset=0:
end
! equivalence and 2-dimensional array
module mb
real :: b1(4), b2, b3, b4
- real :: b(-1:1,2:6) !CHECK: b, PUBLIC size=60 offset=0:
- equivalence(b(1,6), b1) !CHECK: b1, PUBLIC size=16 offset=56:
- equivalence(b(1,5), b2) !CHECK: b2, PUBLIC size=4 offset=44:
- equivalence(b(0,6), b3) !CHECK: b3, PUBLIC size=4 offset=52:
- equivalence(b(0,4), b4) !CHECK: b4, PUBLIC size=4 offset=28:
+ real :: b(-1:1,2:6) !CHECK: b, PUBLIC, SAVE size=60 offset=0:
+ equivalence(b(1,6), b1) !CHECK: b1, PUBLIC, SAVE size=16 offset=56:
+ equivalence(b(1,5), b2) !CHECK: b2, PUBLIC, SAVE size=4 offset=44:
+ equivalence(b(0,6), b3) !CHECK: b3, PUBLIC, SAVE size=4 offset=52:
+ equivalence(b(0,4), b4) !CHECK: b4, PUBLIC, SAVE size=4 offset=28:
end
! equivalence and substring
diff --git a/flang/test/Semantics/resolve121.f90 b/flang/test/Semantics/resolve121.f90
new file mode 100644
index 000000000000000..d84bc53a50f7ce5
--- /dev/null
+++ b/flang/test/Semantics/resolve121.f90
@@ -0,0 +1,45 @@
+! Check that symbols without SAVE attribute from an EQUIVALENCE
+! with at least one symbol being SAVEd (explicitly or implicitly)
+! have implicit SAVE attribute.
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+
+subroutine test1()
+ ! CHECK-LABEL: Subprogram scope: test1
+ ! CHECK: i1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4) init:1_4
+ ! CHECK: j1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ integer :: i1 = 1
+ integer :: j1
+ equivalence(i1,j1)
+end subroutine test1
+
+subroutine test2()
+ ! CHECK-LABEL: Subprogram scope: test2
+ ! CHECK: i1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4) init:1_4
+ ! CHECK: j1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ integer :: i1 = 1
+ integer :: j1
+ equivalence(j1,i1)
+end subroutine test2
+
+subroutine test3()
+ ! CHECK-LABEL: Subprogram scope: test3
+ ! CHECK: i1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ ! CHECK: j1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ ! CHECK: k1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ integer :: i1
+ integer :: j1, k1
+ common /blk/ k1
+ save /blk/
+ equivalence(i1,j1,k1)
+end subroutine test3
+
+subroutine test4()
+ ! CHECK-LABEL: Subprogram scope: test4
+ ! CHECK: i1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4) init:1_4
+ ! CHECK: j1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ ! CHECK: k1, SAVE size=4 offset=0: ObjectEntity type: INTEGER(4)
+ integer :: i1 = 1
+ integer :: j1, k1
+ common /blk/ k1
+ equivalence(i1,j1,k1)
+end subroutine test4
>From f2e9000f3f71823615fb8247b3a229e77bc12815 Mon Sep 17 00:00:00 2001
From: Slava Zakharin <szakharin at nvidia.com>
Date: Fri, 22 Sep 2023 15:49:15 -0700
Subject: [PATCH 3/3] Fixed comment and implicit SAVE propagation.
---
flang/lib/Semantics/resolve-names.cpp | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 23a0370b930aecd..303840b00f8f250 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2390,7 +2390,13 @@ Symbol &ScopeHandler::MakeHostAssocSymbol(
// These attributes can be redundantly reapplied without error
// on the host-associated name, at most once (C815).
symbol.implicitAttrs() =
- symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::SAVE};
+ symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
+ // SAVE statement in the inner scope will create a new symbol.
+ // If the host variable is used via host association,
+ // we have to propagate whether SAVE is implicit in the host scope.
+ // Otherwise, verifications that do not allow explicit SAVE
+ // attribute would fail.
+ symbol.implicitAttrs() |= hostSymbol.implicitAttrs() & Attrs{Attr::SAVE};
symbol.flags() = hostSymbol.flags();
return symbol;
}
More information about the flang-commits
mailing list