[flang-commits] [flang] [flang] Handle procedure pointer and dummy procecure in REDUCE intrinsic calls (PR #95843)
Valentin Clement バレンタイン クレメン via flang-commits
flang-commits at lists.llvm.org
Tue Jun 18 10:54:19 PDT 2024
https://github.com/clementval updated https://github.com/llvm/llvm-project/pull/95843
>From 04fa9253d972b6a2bddf60fcd10aea6f5e405869 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Thu, 13 Jun 2024 13:20:26 -0700
Subject: [PATCH 1/2] [flang] Handle procedure pointer and dummy procecure in
REDUCE intrinsic calls
---
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 6 ++++
flang/test/Lower/Intrinsics/reduce.f90 | 32 +++++++++++++++++--
2 files changed, 36 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index c929d05038462..388e4e1132898 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5751,6 +5751,12 @@ IntrinsicLibrary::genReduce(mlir::Type resultType,
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..3533091b84577 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
+! CHECK: fir.call @_FortranAReduceInteger1Ref
+! STILL NEED SOME WORK HERE fir.call @_FortranAReduceInteger1Value
pure function red_int2(a,b)
integer(2), intent(in) :: a, b
>From 9cf81c4fdb6f968ca7e151e5541ed306b5cc0ef1 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Tue, 18 Jun 2024 10:54:07 -0700
Subject: [PATCH 2/2] Add proper TODO
---
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 2 ++
flang/test/Lower/Intrinsics/reduce.f90 | 8 ++++----
2 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 388e4e1132898..8dd1904939f3e 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5747,6 +5747,8 @@ 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());
diff --git a/flang/test/Lower/Intrinsics/reduce.f90 b/flang/test/Lower/Intrinsics/reduce.f90
index 3533091b84577..8d7ec89d27474 100644
--- a/flang/test/Lower/Intrinsics/reduce.f90
+++ b/flang/test/Lower/Intrinsics/reduce.f90
@@ -55,8 +55,8 @@ subroutine integer1(a, id, d1, d2)
fptr_value => red_int1_value
res = reduce(a, fptr_value)
- res = reduce(a, d1)
- res = reduce(a, d2)
+ !res = reduce(a, d1)
+ !res = reduce(a, d2)
end subroutine
! CHECK-LABEL: func.func @_QMreduce_modPinteger1(
@@ -90,8 +90,8 @@ subroutine integer1(a, id, d1, d2)
! CHECK: fir.call @_FortranAReduceInteger1Value
! CHECK: fir.call @_FortranAReduceInteger1Ref
! CHECK: fir.call @_FortranAReduceInteger1Value
-! CHECK: fir.call @_FortranAReduceInteger1Ref
-! STILL NEED SOME WORK HERE fir.call @_FortranAReduceInteger1Value
+! TODO fir.call @_FortranAReduceInteger1Ref
+! TODO fir.call @_FortranAReduceInteger1Value
pure function red_int2(a,b)
integer(2), intent(in) :: a, b
More information about the flang-commits
mailing list