[flang] Cray pointer in module (#66119)

This patch is to add the support of declaring a Cray pointer in a module.
llvm · Sep 12, 2023 · 602e509 · 602e509
1 parent 9d0291d
commit 602e509
Show file tree

Hide file tree

Showing 4 changed files with 75 additions and 2 deletions.
diff --git 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
@@ -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
@@ -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
+
diff --git a/flang/test/Semantics/modfile57.f90 b/flang/test/Semantics/modfile57.f90
@@ -0,0 +1,19 @@
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+
+! Cray pointer
+module m
+  integer :: pte
+  pointer(ptr,pte)
+  integer :: apte
+  pointer(aptr,apte(7))
+end
+
+!Expect: m.mod
+!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