[flang-commits] [flang] [flang] Cray pointer in module (PR #66119)

[via flang-commits]

https://github.com/kkwli created https://github.com/llvm/llvm-project/pull/66119:

This patch is to add the support of declaring a Cray pointer in a module.

>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] [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
+