[flang-commits] [flang] 887bd73 - [flang] Handle procedure pointer and dummy procecure in REDUCE intrinsic calls (#95843)

[via flang-commits]

Author: Valentin Clement (バレンタイン クレメン)
Date: 2024-06-18T13:09:16-07:00
New Revision: 887bd73d7204a9ae80c608bb7113710be925384b

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

LOG: [flang] Handle procedure pointer and dummy procecure in REDUCE intrinsic calls (#95843)

Add handling for procedure pointer and dummy procedure in REDUCE
intrinsic call lowering.

Added: 
    

Modified: 
    flang/lib/Optimizer/Builder/IntrinsicCall.cpp
    flang/test/Lower/Intrinsics/reduce.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index c929d05038462..8dd1904939f3e 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5747,10 +5747,18 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
 
   // Arguements to the reduction operation are passed by reference or value?
   bool argByRef = true;
+  if (!operation.getDefiningOp())
+    TODO(loc, "Distinguigh dummy procedure arguments");
   if (auto embox =
           mlir::dyn_cast_or_null<fir::EmboxProcOp>(operation.getDefiningOp())) {
     auto fctTy = mlir::dyn_cast<mlir::FunctionType>(embox.getFunc().getType());
     argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0));
+  } else if (auto load = mlir::dyn_cast_or_null<fir::LoadOp>(
+                 operation.getDefiningOp())) {
+    auto boxProcTy = mlir::dyn_cast_or_null<fir::BoxProcType>(load.getType());
+    assert(boxProcTy && "expect BoxProcType");
+    auto fctTy = mlir::dyn_cast<mlir::FunctionType>(boxProcTy.getEleTy());
+    argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0));
   }
 
   mlir::Type ty = array.getType();

diff  --git a/flang/test/Lower/Intrinsics/reduce.f90 b/flang/test/Lower/Intrinsics/reduce.f90
index 358897b05adce..8d7ec89d27474 100644
--- a/flang/test/Lower/Intrinsics/reduce.f90
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -6,6 +6,17 @@ module reduce_mod
   integer :: a
 end type
 
+  abstract interface
+    pure function red_int1_interface(a, b)
+      integer(1), intent(in) :: a, b
+      integer(1) :: red_int1_interface
+    end function
+    pure function red_int1_interface_value(a, b)
+      integer(1), value, intent(in) :: a, b
+      integer(1) :: red_int1_interface_value
+    end function
+  end interface
+
 contains
 
 pure function red_int1(a,b)
@@ -20,9 +31,13 @@ pure function red_int1_value(a,b)
   red_int1_value = a + b
 end function
 
-subroutine integer1(a, id)
+subroutine integer1(a, id, d1, d2)
   integer(1), intent(in) :: a(:)
   integer(1) :: res, id
+  procedure(red_int1_interface), pointer :: fptr
+  procedure(red_int1_interface_value), pointer :: fptr_value
+  procedure(red_int1_interface) :: d1
+  procedure(red_int1_interface_value) :: d2
 
   res = reduce(a, red_int1)
 
@@ -33,10 +48,19 @@ subroutine integer1(a, id)
   res = reduce(a, red_int1, [.true., .true., .false.])
   
   res = reduce(a, red_int1_value)
+
+  fptr => red_int1
+  res = reduce(a, fptr)
+
+  fptr_value => red_int1_value
+  res = reduce(a, fptr_value)
+
+  !res = reduce(a, d1)
+  !res = reduce(a, d2)
 end subroutine
 
 ! CHECK-LABEL: func.func @_QMreduce_modPinteger1(
-! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?xi8>> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref<i8> {fir.bindc_name = "id"})
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?xi8>> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref<i8> {fir.bindc_name = "id"}
 ! CHECK: %[[A:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMreduce_modFinteger1Ea"} : (!fir.box<!fir.array<?xi8>>, !fir.dscope) -> (!fir.box<!fir.array<?xi8>>, !fir.box<!fir.array<?xi8>>)
 ! CHECK: %[[ID:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %{{.*}} {uniq_name = "_QMreduce_modFinteger1Eid"} : (!fir.ref<i8>, !fir.dscope) -> (!fir.ref<i8>, !fir.ref<i8>)
 ! CHECK: %[[ALLOC_RES:.*]] = fir.alloca i8 {bindc_name = "res", uniq_name = "_QMreduce_modFinteger1Eres"}
@@ -64,6 +88,10 @@ subroutine integer1(a, id)
 ! CHECK: %[[CONV_MASK:.*]] = fir.convert %[[BOXED_MASK]] : (!fir.box<!fir.array<3x!fir.logical<4>>>) -> !fir.box<none>
 ! CHECK: fir.call @_FortranAReduceInteger1Ref(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[CONV_MASK]], %{{.*}}, %false{{.*}})
 ! CHECK: fir.call @_FortranAReduceInteger1Value
+! CHECK: fir.call @_FortranAReduceInteger1Ref
+! CHECK: fir.call @_FortranAReduceInteger1Value
+! TODO fir.call @_FortranAReduceInteger1Ref
+! TODO fir.call @_FortranAReduceInteger1Value
 
 pure function red_int2(a,b)
   integer(2), intent(in) :: a, b