[flang-commits] [flang] fa08e97 - [flang] lower assumed-rank TARGET to intent(in) POINTER (#96082)

[via flang-commits]

Author: jeanPerier
Date: 2024-06-20T09:01:07+02:00
New Revision: fa08e97d03afd215caeb297a822895c4d0d93b7b

URL: https://github.com/llvm/llvm-project/commit/fa08e97d03afd215caeb297a822895c4d0d93b7b
DIFF: https://github.com/llvm/llvm-project/commit/fa08e97d03afd215caeb297a822895c4d0d93b7b.diff

LOG: [flang] lower assumed-rank TARGET to intent(in) POINTER (#96082)

The only special thing to do is to use fir.rebox_assumed_rank when
reboxing the target to properly set the POINTER attribute inside the
descriptor.

Added: 
    

Modified: 
    flang/lib/Lower/ConvertCall.cpp
    flang/lib/Optimizer/Builder/MutableBox.cpp
    flang/test/Lower/HLFIR/assumed-rank-calls.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 382419a1c3267..5e20f9eee4fc9 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1597,9 +1597,6 @@ void prepareUserCallArguments(
         if (dataTy.isAssumedRank()) {
           dataTy =
               dataTy.getBoxTypeWithNewShape(fir::getBase(actualExv).getType());
-          if (dataTy.isAssumedRank())
-            TODO(loc, "associating assumed-rank target to pointer assumed-rank "
-                      "argument");
         }
         mlir::Value irBox = builder.createTemporary(loc, dataTy);
         fir::MutableBoxValue ptrBox(irBox,

diff  --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index 16e543fe86a79..52d149fa7b9a0 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -527,7 +527,14 @@ void fir::factory::associateMutableBox(fir::FirOpBuilder &builder,
         mlir::ValueRange newLbounds = lbounds.empty()
                                           ? mlir::ValueRange{arr.getLBounds()}
                                           : mlir::ValueRange{lbounds};
-        if (box.isDescribedByVariables()) {
+        if (box.hasAssumedRank()) {
+          assert(arr.hasAssumedRank() &&
+                 "expect both arr and box to be assumed-rank");
+          mlir::Value reboxed = builder.create<fir::ReboxAssumedRankOp>(
+              loc, box.getBoxTy(), arr.getAddr(),
+              fir::LowerBoundModifierAttribute::Preserve);
+          writer.updateWithIrBox(reboxed);
+        } else if (box.isDescribedByVariables()) {
           // LHS is a contiguous pointer described by local variables. Open RHS
           // fir.box to update the LHS.
           auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(),

diff  --git a/flang/test/Lower/HLFIR/assumed-rank-calls.f90 b/flang/test/Lower/HLFIR/assumed-rank-calls.f90
index 071589bf95140..9d4503fef6fce 100644
--- a/flang/test/Lower/HLFIR/assumed-rank-calls.f90
+++ b/flang/test/Lower/HLFIR/assumed-rank-calls.f90
@@ -40,6 +40,24 @@ subroutine bindc_func(x) bind(c)
 ! CHECK:           return
 ! CHECK:         }
 
+subroutine test_target_to_pointer(x)
+  real, target ::  x(..)
+  interface
+    subroutine takes_target_as_pointer(x)
+      real, pointer, intent(in) :: x(..)
+    end subroutine
+  end interface
+  call takes_target_as_pointer(x)
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_target_to_pointer(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x", fir.target}) {
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<*:f32>>>
+! CHECK:           %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_2]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFtest_target_to_pointerEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+! CHECK:           %[[VAL_4:.*]] = fir.rebox_assumed_rank %[[VAL_3]]#0 lbs preserve : (!fir.box<!fir.array<*:f32>>) -> !fir.box<!fir.ptr<!fir.array<*:f32>>>
+! CHECK:           fir.store %[[VAL_4]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>
+! CHECK:           fir.call @_QPtakes_target_as_pointer(%[[VAL_1]]) fastmath<contract> : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>) -> ()
+
 subroutine test_poly_to_nonepoly(x)
   type t
     integer :: i