[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