[flang-commits] [flang] [Flang] Add partial support for lowering procedure pointer assignment. (PR #70461)

[Daniel Chen via flang-commits]

================
@@ -870,6 +878,22 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
+  // Handles the procedure pointer actual/dummy arguments.
+  // It could have a combination of
+  //     acutal             dummy
+  // 2.  procedure pointer  procedure pointer
+  // 3.  procedure pointer  procedure
+  // 4.  procedure          procedure pointer
+  if (hlfir::isBoxProcAddressType(actual.getType()) ||
+      hlfir::isBoxProcAddressType(dummyType)) {
+    if (actual.getType() != dummyType &&
+        hlfir::isBoxProcAddressType(actual.getType())) {
+      auto baseAddr{actual.getFirBase()};
+      actual = hlfir::Entity{builder.create<fir::LoadOp>(loc, baseAddr)};
+    }
+    return PreparedDummyArgument{actual, /*cleanups=*/{}};
+  }
----------------
DanielCChen wrote:

-- "I think the procedure actual to procedure pointer actual may not be covered here (I would expect a temp + store created to cover this case)." 

I tired 
```
subroutine proc_pointer_local()
  interface
    function func(x)
      integer :: x
    end function func
  end interface
  procedure(func), pointer :: p
  procedure(func) :: ttt
  call foo2(ttt)
contains
  subroutine foo2(q)
    procedure(func), pointer, intent(in) :: q
  end subroutine foo2
end subroutine proc_pointer_local
```

It generates:
```
  func.func @_QPproc_pointer_local() {
    %0 = fir.alloca !fir.boxproc<() -> ()> {bindc_name = "p", uniq_name = "_QFproc_pointer_localEp"}
    %1 = fir.zero_bits (!fir.ref<i32>) -> f32
    %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<() -> ()>
    fir.store %2 to %0 : !fir.ref<!fir.boxproc<() -> ()>>
    %3 = fir.declare %0 {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFproc_pointer_localEp"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> !fir.ref<!fir.boxproc<() -> ()>>
    %4 = fir.address_of(@_QPttt) : (!fir.ref<i32>) -> f32
    %5 = fir.emboxproc %4 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<() -> ()>
    fir.call @_QPfoo1(%5) fastmath<contract> : (!fir.boxproc<() -> ()>) -> ()
    %6 = fir.address_of(@_QPttt) : (!fir.ref<i32>) -> f32
    %7 = fir.emboxproc %6 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<() -> ()>
    %8 = fir.box_addr %7 : (!fir.boxproc<() -> ()>) -> !fir.ref<!fir.boxproc<() -> ()>>
    fir.call @_QFproc_pointer_localPfoo2(%8) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
    return
  }
  func.func @_QFproc_pointer_localPfoo2(%arg0: !fir.ref<!fir.boxproc<() -> ()>>) {
    %0 = fir.declare %arg0 {fortran_attrs = #fir.var_attrs<intent_in, pointer>, uniq_name = "_QFproc_pointer_localFfoo2Eq"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> !fir.ref<!fir.boxproc<() -> ()>>
    return
  }
  ```
  
  It seems OK to me.

https://github.com/llvm/llvm-project/pull/70461