[flang-commits] [flang] [flang] Cray pointer in module (PR #66119)
via flang-commits
flang-commits at lists.llvm.org
Tue Sep 12 12:37:43 PDT 2023
https://github.com/kkwli updated https://github.com/llvm/llvm-project/pull/66119:
>From 05de40ee43ce6d52f3888d486634fa990597e93a Mon Sep 17 00:00:00 2001
From: Kelvin Li <kli at ca.ibm.com>
Date: Tue, 12 Sep 2023 11:55:35 -0400
Subject: [PATCH 1/3] [flang] Cray pointer in module
This patch is to add the support of declaring a Cray pointer in a module.
---
flang/lib/Lower/ConvertVariable.cpp | 5 ++--
flang/lib/Semantics/mod-file.cpp | 9 ++++++
flang/test/Lower/cray-pointer.f90 | 44 +++++++++++++++++++++++++++++
3 files changed, 56 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index cad86f78307870b..03a7cca1ab69817 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -2152,9 +2152,10 @@ void Fortran::lower::createRuntimeTypeInfoGlobal(
Fortran::semantics::SymbolRef
Fortran::lower::getCrayPointer(Fortran::semantics::SymbolRef sym) {
- assert(!sym->owner().crayPointers().empty() &&
+ assert(!sym->GetUltimate().owner().crayPointers().empty() &&
"empty Cray pointer/pointee map");
- for (const auto &[pointee, pointer] : sym->owner().crayPointers()) {
+ for (const auto &[pointee, pointer] :
+ sym->GetUltimate().owner().crayPointers()) {
if (pointee == sym->name()) {
Fortran::semantics::SymbolRef v{pointer.get()};
return v;
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 3925f3b0ef0335e..15d6f62f706c922 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -759,6 +759,15 @@ void ModFileWriter::PutObjectEntity(
PutLower(os << "attributes(", common::EnumToString(*attr))
<< ") " << symbol.name() << '\n';
}
+ if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {
+ if (!symbol.owner().crayPointers().empty()) {
+ for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {
+ if (pointer == symbol) {
+ os << "pointer(" << symbol.name() << "," << pointee << ")\n";
+ }
+ }
+ }
+ }
}
void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
diff --git a/flang/test/Lower/cray-pointer.f90 b/flang/test/Lower/cray-pointer.f90
index f0c0c0f73f2a64e..c9f3a4ca88ac35b 100644
--- a/flang/test/Lower/cray-pointer.f90
+++ b/flang/test/Lower/cray-pointer.f90
@@ -402,3 +402,47 @@ subroutine cray_arraySection()
! CHECK: fir.result %[[arrayupdate]] : !fir.array<3xi32>
! CHECK: fir.array_merge_store %[[arrayld]], %[[doloop]] to %[[ld]][%[[slice]]] : !fir.array<3xi32>, !fir.array<3xi32>, !fir.ptr<!fir.array<3xi32>>, !fir.slice<1>
end
+
+! Test Cray pointer declared in a module
+module mod_cray_ptr
+ integer :: pte
+ pointer(ptr, pte)
+end module
+
+! CHECK-LABEL: @_QPtest_ptr
+subroutine test_ptr()
+ use mod_cray_ptr
+ implicit none
+ integer :: x
+ ptr = loc(x)
+! CHECK: %[[ptr:.*]] = fir.address_of(@_QMmod_cray_ptrEptr) : !fir.ref<i64>
+! CHECK: %[[x:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFtest_ptrEx"}
+! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK: %[[boxAddr:.*]] = fir.box_addr %[[box]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK: %[[addr_x:.*]] = fir.convert %[[boxAddr]] : (!fir.ref<i32>) -> i64
+! CHECK: fir.store %[[addr_x]] to %[[ptr]] : !fir.ref<i64>
+end
+
+subroutine test_pte()
+ use mod_cray_ptr
+ implicit none
+ integer :: x
+ pte = x
+! CHECK: %[[ptr:.*]] = fir.address_of(@_QMmod_cray_ptrEptr) : !fir.ref<i64>
+! CHECK: %[[x:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFtest_pteEx"}
+! CHECK: %[[xval:.*]] = fir.load %[[x]] : !fir.ref<i32>
+! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref<i64>) -> !fir.box<i64>
+! CHECK: %[[boxAddr:.*]] = fir.box_addr %[[box]] : (!fir.box<i64>) -> !fir.ref<i64>
+! CHECK: %[[ptr2:.*]] = fir.convert %[[boxAddr]] : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i32>>
+! CHECK: %[[ptr2val:.*]] = fir.load %[[ptr2]] : !fir.ref<!fir.ptr<i32>>
+! CHECK: fir.store %[[xval]] to %[[ptr2val]] : !fir.ptr<i32>
+
+ x = pte
+! CHECK: %[[box2:.*]] = fir.embox %[[ptr]] : (!fir.ref<i64>) -> !fir.box<i64>
+! CHECK: %[[box2Addr:.*]] = fir.box_addr %[[box2]] : (!fir.box<i64>) -> !fir.ref<i64>
+! CHECK: %[[refptr:.*]] = fir.convert %[[box2Addr]] : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i32>>
+! CHECK: %[[ptr4:.*]] = fir.load %[[refptr]] : !fir.ref<!fir.ptr<i32>>
+! CHECK: %[[val:.*]] = fir.load %[[ptr4]] : !fir.ptr<i32>
+! CHECK: fir.store %[[val]] to %[[x]] : !fir.ref<i32>
+end
+
>From e1c3bf18f3ac61dd54ff6ffc70bbba4ab5de3525 Mon Sep 17 00:00:00 2001
From: Kelvin Li <kli at ca.ibm.com>
Date: Tue, 12 Sep 2023 14:16:33 -0400
Subject: [PATCH 2/3] Add a LIT test to check the module
---
flang/test/Semantics/modfile57.f90 | 14 ++++++++++++++
1 file changed, 14 insertions(+)
create mode 100644 flang/test/Semantics/modfile57.f90
diff --git a/flang/test/Semantics/modfile57.f90 b/flang/test/Semantics/modfile57.f90
new file mode 100644
index 000000000000000..547ac36674c9cff
--- /dev/null
+++ b/flang/test/Semantics/modfile57.f90
@@ -0,0 +1,14 @@
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+
+! Cray pointer
+module m
+ integer :: pte
+ pointer(ptr,pte)
+end
+
+!Expect: m.mod
+!module m
+!integer(4)::pte
+!integer(8)::ptr
+!pointer(ptr,pte)
+!end
>From 7fbddf619caaa8b3a27e104e54f082a378613470 Mon Sep 17 00:00:00 2001
From: Kelvin Li <kli at ca.ibm.com>
Date: Tue, 12 Sep 2023 15:35:57 -0400
Subject: [PATCH 3/3] Add array to LIT test
---
flang/test/Semantics/modfile57.f90 | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/flang/test/Semantics/modfile57.f90 b/flang/test/Semantics/modfile57.f90
index 547ac36674c9cff..21929eb5b2bc60d 100644
--- a/flang/test/Semantics/modfile57.f90
+++ b/flang/test/Semantics/modfile57.f90
@@ -4,6 +4,8 @@
module m
integer :: pte
pointer(ptr,pte)
+ integer :: apte
+ pointer(aptr,apte(7))
end
!Expect: m.mod
@@ -11,4 +13,7 @@ module m
!integer(4)::pte
!integer(8)::ptr
!pointer(ptr,pte)
+!integer(4)::apte(1_8:7_8)
+!integer(8)::aptr
+!pointer(aptr,apte)
!end
More information about the flang-commits
mailing list