diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index b34d7629613b..e706fedda734 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -2516,7 +2516,8 @@ def fir_DispatchOp : fir_Op<"dispatch", []> { StrAttr:$method, fir_ClassType:$object, Variadic:$args, - OptionalAttr:$pass_arg_pos + OptionalAttr:$pass_arg_pos, + OptionalAttr:$procedure_attrs ); let results = (outs Variadic:$results); @@ -2525,7 +2526,8 @@ def fir_DispatchOp : fir_Op<"dispatch", []> { let assemblyFormat = [{ $method `(` $object `:` qualified(type($object)) `)` - ( `(` $args^ `:` type($args) `)` )? (`->` type($results)^)? attr-dict + ( `(` $args^ `:` type($args) `)` )? (`->` type($results)^)? + (`proc_attrs` $procedure_attrs^)? attr-dict }]; let extraClassDeclaration = [{ diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 59f29c409c79..9f5b58590fb7 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -523,6 +523,8 @@ std::pair Fortran::lower::genCallOpAndResult( mlir::Value callResult; unsigned callNumResults; + fir::FortranProcedureFlagsEnumAttr procAttrs = + caller.getProcedureAttrs(builder.getContext()); if (!caller.getCallDescription().chevrons().empty()) { // A call to a CUDA kernel with the chevron syntax. @@ -610,7 +612,7 @@ std::pair Fortran::lower::genCallOpAndResult( dispatch = builder.create( loc, funcType.getResults(), builder.getStringAttr(procName), caller.getInputs()[*passArg], operands, - builder.getI32IntegerAttr(*passArg)); + builder.getI32IntegerAttr(*passArg), procAttrs); } else { // NOPASS const Fortran::evaluate::Component *component = @@ -625,15 +627,13 @@ std::pair Fortran::lower::genCallOpAndResult( passObject = builder.create(loc, passObject); dispatch = builder.create( loc, funcType.getResults(), builder.getStringAttr(procName), - passObject, operands, nullptr); + passObject, operands, nullptr, procAttrs); } callNumResults = dispatch.getNumResults(); if (callNumResults != 0) callResult = dispatch.getResult(0); } else { // Standard procedure call with fir.call. - fir::FortranProcedureFlagsEnumAttr procAttrs = - caller.getProcedureAttrs(builder.getContext()); auto call = builder.create( loc, funcType.getResults(), funcSymbolAttr, operands, procAttrs); diff --git a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp index f6cb26ff9613..925b93212b09 100644 --- a/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/TargetRewrite.cpp @@ -507,7 +507,8 @@ public: fir::DispatchOp dispatchOp = rewriter->create( loc, newResTys, rewriter->getStringAttr(callOp.getMethod()), callOp.getOperands()[0], newOpers, - rewriter->getI32IntegerAttr(*callOp.getPassArgPos() + passArgShift)); + rewriter->getI32IntegerAttr(*callOp.getPassArgPos() + passArgShift), + callOp.getProcedureAttrsAttr()); if (wrap) newCallResults.push_back((*wrap)(dispatchOp.getOperation())); else diff --git a/flang/lib/Optimizer/Transforms/AbstractResult.cpp b/flang/lib/Optimizer/Transforms/AbstractResult.cpp index ff37310224e8..7299ff80121e 100644 --- a/flang/lib/Optimizer/Transforms/AbstractResult.cpp +++ b/flang/lib/Optimizer/Transforms/AbstractResult.cpp @@ -154,17 +154,14 @@ public: newOperands.emplace_back(arg); unsigned passArgShift = newOperands.size(); newOperands.append(op.getOperands().begin() + 1, op.getOperands().end()); - - fir::DispatchOp newDispatchOp; + mlir::IntegerAttr passArgPos; if (op.getPassArgPos()) - newOp = rewriter.create( - loc, newResultTypes, rewriter.getStringAttr(op.getMethod()), - op.getOperands()[0], newOperands, - rewriter.getI32IntegerAttr(*op.getPassArgPos() + passArgShift)); - else - newOp = rewriter.create( - loc, newResultTypes, rewriter.getStringAttr(op.getMethod()), - op.getOperands()[0], newOperands, nullptr); + passArgPos = + rewriter.getI32IntegerAttr(*op.getPassArgPos() + passArgShift); + newOp = rewriter.create( + loc, newResultTypes, rewriter.getStringAttr(op.getMethod()), + op.getOperands()[0], newOperands, passArgPos, + op.getProcedureAttrsAttr()); } if (isResultBuiltinCPtr) { diff --git a/flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp b/flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp index 105f275de8b9..070889a284f4 100644 --- a/flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp +++ b/flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp @@ -205,10 +205,8 @@ struct DispatchOpConv : public OpConversionPattern { // Make the call. llvm::SmallVector args{funcPtr}; args.append(dispatch.getArgs().begin(), dispatch.getArgs().end()); - // FIXME: add procedure_attrs to fir.dispatch and propagate to fir.call. - rewriter.replaceOpWithNewOp( - dispatch, resTypes, nullptr, args, - /*procedure_attrs=*/fir::FortranProcedureFlagsEnumAttr{}); + rewriter.replaceOpWithNewOp(dispatch, resTypes, nullptr, args, + dispatch.getProcedureAttrsAttr()); return mlir::success(); } diff --git a/flang/test/Fir/dispatch.f90 b/flang/test/Fir/dispatch.f90 index fc935217defa..2ffdcd5b1884 100644 --- a/flang/test/Fir/dispatch.f90 +++ b/flang/test/Fir/dispatch.f90 @@ -18,6 +18,7 @@ module dispatch1 procedure :: proc_with_values => proc_p1 procedure, nopass :: proc_nopass => proc_nopass_p1 procedure, pass(this) :: proc_pass => proc_pass_p1 + procedure, nopass :: z_proc_nopass_bindc => proc_nopass_bindc_p1 end type type, extends(p1) :: p2 @@ -30,6 +31,7 @@ module dispatch1 procedure :: proc_with_values => proc_p2 procedure, nopass :: proc_nopass => proc_nopass_p2 procedure, pass(this) :: proc_pass => proc_pass_p2 + procedure, nopass :: z_proc_nopass_bindc => proc_nopass_bindc_p2 end type type, abstract :: a1 @@ -118,16 +120,24 @@ contains print*, 'call proc_nopass_p2' end subroutine + subroutine proc_nopass_bindc_p1() bind(c) + print*, 'call proc_nopass_bindc_p1' + end subroutine + + subroutine proc_nopass_bindc_p2() bind(c) + print*, 'call proc_nopass_bindc_p2' + end subroutine + subroutine proc_pass_p1(i, this) integer :: i class(p1) :: this - print*, 'call proc_nopass_p1' + print*, 'call proc_pass_p1' end subroutine subroutine proc_pass_p2(i, this) integer :: i class(p2) :: this - print*, 'call proc_nopass_p2' + print*, 'call proc_pass_p2' end subroutine subroutine display_class(p) @@ -140,6 +150,7 @@ contains call p%proc_with_values(2.5) call p%proc_nopass() call p%proc_pass(1) + call p%z_proc_nopass_bindc() end subroutine subroutine no_pass_array(a) @@ -297,6 +308,10 @@ end ! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> ((!fir.ref, [[CLASS]]) -> ()) ! CHECK: fir.call %[[FUNC_PTR]](%{{.*}}, %[[ARG_DECL]]#0) : (!fir.ref, [[CLASS]]) -> () +! Test attributes are propagated from fir.dispatch to fir.call +! for `call p%z_proc_nopass_bindc()` +! CHECK: fir.call %{{.*}}() proc_attrs : () -> () + ! CHECK-LABEL: _QMdispatch1Pno_pass_array ! CHECK-LABEL: _QMdispatch1Pno_pass_array_allocatable ! CHECK-LABEL: _QMdispatch1Pno_pass_array_pointer @@ -316,6 +331,7 @@ end ! BT: fir.dt_entry "proc_nopass", @_QMdispatch1Pproc_nopass_p1 ! BT: fir.dt_entry "proc_pass", @_QMdispatch1Pproc_pass_p1 ! BT: fir.dt_entry "proc_with_values", @_QMdispatch1Pproc_p1 +! BT: fir.dt_entry "z_proc_nopass_bindc", @proc_nopass_bindc_p1 ! BT: } ! BT-LABEL: fir.type_info @_QMdispatch1Ta1 @@ -334,5 +350,6 @@ end ! BT: fir.dt_entry "proc_nopass", @_QMdispatch1Pproc_nopass_p2 ! BT: fir.dt_entry "proc_pass", @_QMdispatch1Pproc_pass_p2 ! BT: fir.dt_entry "proc_with_values", @_QMdispatch1Pproc_p2 +! BT: fir.dt_entry "z_proc_nopass_bindc", @proc_nopass_bindc_p2 ! BT: fir.dt_entry "display3", @_QMdispatch1Pdisplay3 ! BT: } diff --git a/flang/test/Fir/fir-ops.fir b/flang/test/Fir/fir-ops.fir index 5d66bfe645de..ab1c890947af 100644 --- a/flang/test/Fir/fir-ops.fir +++ b/flang/test/Fir/fir-ops.fir @@ -805,8 +805,8 @@ func.func private @dispatch(%arg0: !fir.class>) (%arg0 : !fir.class>) {pass_arg_pos = 0 : i32} // CHECK: fir.dispatch "proc1"(%[[CLASS]] : !fir.class>) (%[[CLASS]] : !fir.class>) {pass_arg_pos = 0 : i32} - fir.dispatch "proc2"(%arg0 : !fir.class>) - // CHECK: fir.dispatch "proc2"(%[[CLASS]] : !fir.class>) + fir.dispatch "proc2"(%arg0 : !fir.class>) proc_attrs + // CHECK: fir.dispatch "proc2"(%[[CLASS]] : !fir.class>) proc_attrs fir.dispatch "proc3"(%arg0 : !fir.class>) (%arg1, %arg0 : i32, !fir.class>) {pass_arg_pos = 1 : i32} // CHECK: fir.dispatch "proc3"(%[[CLASS]] : !fir.class>) (%[[INTARG]], %[[CLASS]] : i32, !fir.class>) {pass_arg_pos = 1 : i32} diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 index 14ec8a06a964..5904ecc19224 100644 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -578,7 +578,7 @@ module polymorphic_test ! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5xi32>) { ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class>>, index) -> !fir.ref> ! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref>, !fir.class>>) -> !fir.class> -! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) -> i32 {pass_arg_pos = 0 : i32} +! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) -> i32 proc_attrs {pass_arg_pos = 0 : i32} ! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[RES]], %[[IND]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32> ! CHECK: fir.result %[[ARR_UP]] : !fir.array<5xi32> ! CHECK: } @@ -609,7 +609,7 @@ module polymorphic_test ! CHECK: %[[LOOP_RES0:.*]] = fir.do_loop %[[IND1:.*]] = %[[C0]] to %[[UB0]] step %[[C1]] unordered iter_args(%[[ARG0:.*]] = %[[ARG]]) -> (!fir.array<5x5xi32>) { ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND1]], %[[IND0]] : (!fir.class>>, index, index) -> !fir.ref> ! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref>, !fir.class>>) -> !fir.class> -! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) -> i32 {pass_arg_pos = 0 : i32} +! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) -> i32 proc_attrs {pass_arg_pos = 0 : i32} ! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG0]], %[[RES]], %[[IND1]], %[[IND0]] : (!fir.array<5x5xi32>, i32, index, index) -> !fir.array<5x5xi32> ! CHECK: fir.result %[[ARR_UP]] : !fir.array<5x5xi32> ! CHECK: } @@ -663,7 +663,7 @@ module polymorphic_test ! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] { ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class>>, index) -> !fir.ref> ! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref>, !fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) proc_attrs {pass_arg_pos = 0 : i32} ! CHECK: } ! CHECK: %[[C1:.*]] = arith.constant 1 : index ! CHECK: %[[C0:.*]] = arith.constant 0 : index @@ -671,7 +671,7 @@ module polymorphic_test ! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] { ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class>>, index) -> !fir.ref> ! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref>, !fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class>) (%{{.*}}, %[[EMBOXED]] : !fir.ref, !fir.class>) {pass_arg_pos = 1 : i32} +! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class>) (%{{.*}}, %[[EMBOXED]] : !fir.ref, !fir.class>) proc_attrs {pass_arg_pos = 1 : i32} ! CHECK: } subroutine test_elemental_sub_array_assumed(t) @@ -718,7 +718,7 @@ module polymorphic_test ! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] { ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class>>, index) -> !fir.ref> ! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref>, !fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class>) (%[[EMBOXED]] : !fir.class>) proc_attrs {pass_arg_pos = 0 : i32} ! CHECK: } ! CHECK: %[[C0:.*]] = arith.constant 0 : index ! CHECK: %[[P_DIMS:.*]]:3 = fir.box_dims %[[P]], %[[C0]] : (!fir.class>>, index) -> (index, index, index) @@ -728,7 +728,7 @@ module polymorphic_test ! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] { ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class>>, index) -> !fir.ref> ! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref>, !fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class>) (%{{.*}}, %[[EMBOXED]] : !fir.ref, !fir.class>) {pass_arg_pos = 1 : i32} +! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class>) (%{{.*}}, %[[EMBOXED]] : !fir.ref, !fir.class>) proc_attrs {pass_arg_pos = 1 : i32} ! CHECK: } subroutine write_p1(dtv, unit, iotype, v_list, iostat, iomsg)