diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index 1fb390455733f3..72bc9dd890a94b 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -248,6 +248,7 @@ class CallInterface { CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {} /// CRTP handle. T &side() { return *static_cast(this); } + const T &side() const { return *static_cast(this); } /// Entry point to be called by child ctor to analyze the signature and /// create/find the mlir::func::FuncOp. Child needs to be initialized first. void declare(); diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h index 50e18792a167ab..cdbefdb2341485 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h +++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h @@ -160,6 +160,10 @@ static constexpr llvm::StringRef getFuncRecursiveAttrName() { return "fir.func_recursive"; } +static constexpr llvm::StringRef getFortranProcedureFlagsAttrName() { + return "fir.proc_attrs"; +} + // Attribute for an alloca that is a trivial adaptor for converting a value to // pass-by-ref semantics for a VALUE parameter. The optimizer may be able to // eliminate these. diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index f541f847382917..7fc6b14f9c6606 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -582,6 +582,7 @@ mlir::Value Fortran::lower::CalleeInterface::getHostAssociatedTuple() const { static void addSymbolAttribute(mlir::func::FuncOp func, const Fortran::semantics::Symbol &sym, + fir::FortranProcedureFlagsEnumAttr procAttrs, mlir::MLIRContext &mlirContext) { const Fortran::semantics::Symbol &ultimate = sym.GetUltimate(); // The link between an internal procedure and its host procedure is lost @@ -611,16 +612,8 @@ static void addSymbolAttribute(mlir::func::FuncOp func, } } - // Set procedure attributes to the func op. - if (IsPureProcedure(sym)) - func->setAttr(fir::getFuncPureAttrName(), - mlir::UnitAttr::get(&mlirContext)); - if (IsElementalProcedure(sym)) - func->setAttr(fir::getFuncElementalAttrName(), - mlir::UnitAttr::get(&mlirContext)); - if (sym.attrs().test(Fortran::semantics::Attr::RECURSIVE)) - func->setAttr(fir::getFuncRecursiveAttrName(), - mlir::UnitAttr::get(&mlirContext)); + if (procAttrs) + func->setAttr(fir::getFortranProcedureFlagsAttrName(), procAttrs); // Only add this on bind(C) functions for which the symbol is not reflected in // the current context. @@ -703,6 +696,7 @@ void Fortran::lower::CallInterface::declare() { func = fir::FirOpBuilder::getNamedFunction(module, symbolTable, name); if (!func) { mlir::Location loc = side().getCalleeLocation(); + mlir::MLIRContext &mlirContext = converter.getMLIRContext(); mlir::FunctionType ty = genFunctionType(); func = fir::FirOpBuilder::createFunction(loc, module, name, ty, symbolTable); @@ -712,7 +706,8 @@ void Fortran::lower::CallInterface::declare() { mlir::StringAttr::get(&converter.getMLIRContext(), sym->name().ToString())); } else { - addSymbolAttribute(func, *sym, converter.getMLIRContext()); + addSymbolAttribute(func, *sym, getProcedureAttrs(&mlirContext), + mlirContext); } } for (const auto &placeHolder : llvm::enumerate(inputs)) @@ -1550,8 +1545,8 @@ template fir::FortranProcedureFlagsEnumAttr Fortran::lower::CallInterface::getProcedureAttrs( mlir::MLIRContext *mlirContext) const { + fir::FortranProcedureFlagsEnum flags = fir::FortranProcedureFlagsEnum::none; if (characteristic) { - fir::FortranProcedureFlagsEnum flags = fir::FortranProcedureFlagsEnum::none; if (characteristic->IsBindC()) flags = flags | fir::FortranProcedureFlagsEnum::bind_c; if (characteristic->IsPure()) @@ -1560,12 +1555,27 @@ Fortran::lower::CallInterface::getProcedureAttrs( flags = flags | fir::FortranProcedureFlagsEnum::elemental; // TODO: // - SIMPLE: F2023, not yet handled by semantics. - // - NON_RECURSIVE: not part of the characteristics. Maybe this should - // simply not be part of FortranProcedureFlagsEnum since cannot accurately - // be known on the caller side. - if (flags != fir::FortranProcedureFlagsEnum::none) - return fir::FortranProcedureFlagsEnumAttr::get(mlirContext, flags); } + + if constexpr (std::is_same_v) { + // Only gather and set NON_RECURSIVE for procedure definition. It is + // meaningless on calls since this is not part of Fortran characteristics + // (Fortran 2023 15.3.1) so there is no way to always know if the procedure + // called is recursive or not. + if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol()) { + // Note: By default procedures are RECURSIVE unless + // -fno-automatic/-save/-Msave is set. NON_RECURSIVE is is made explicit + // in that case in FIR. + if (sym->attrs().test(Fortran::semantics::Attr::NON_RECURSIVE) || + (sym->owner().context().languageFeatures().IsEnabled( + Fortran::common::LanguageFeature::DefaultSave) && + !sym->attrs().test(Fortran::semantics::Attr::RECURSIVE))) { + flags = flags | fir::FortranProcedureFlagsEnum::non_recursive; + } + } + } + if (flags != fir::FortranProcedureFlagsEnum::none) + return fir::FortranProcedureFlagsEnumAttr::get(mlirContext, flags); return nullptr; } diff --git a/flang/test/Lower/CUDA/cuda-device-proc.cuf b/flang/test/Lower/CUDA/cuda-device-proc.cuf index bed0a4574fe94d..1331b644130c87 100644 --- a/flang/test/Lower/CUDA/cuda-device-proc.cuf +++ b/flang/test/Lower/CUDA/cuda-device-proc.cuf @@ -26,11 +26,11 @@ end ! CHECK: %{{.*}} = fir.call @__syncthreads_count(%{{.*}}) proc_attrs fastmath : (!fir.ref) -> i32 ! CHECK: %{{.*}} = fir.call @__syncthreads_or(%{{.*}}) proc_attrs fastmath : (!fir.ref) -> i32 -! CHECK: func.func private @__syncthreads() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads"} -! CHECK: func.func private @__syncwarp(!fir.ref {cuf.data_attr = #cuf.cuda}) attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncwarp"} -! CHECK: func.func private @__threadfence() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__threadfence"} -! CHECK: func.func private @__threadfence_block() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__threadfence_block"} -! CHECK: func.func private @__threadfence_system() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__threadfence_system"} -! CHECK: func.func private @__syncthreads_and(!fir.ref {cuf.data_attr = #cuf.cuda}) -> i32 attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads_and"} -! CHECK: func.func private @__syncthreads_count(!fir.ref {cuf.data_attr = #cuf.cuda}) -> i32 attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads_count"} -! CHECK: func.func private @__syncthreads_or(!fir.ref {cuf.data_attr = #cuf.cuda}) -> i32 attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads_or"} +! CHECK: func.func private @__syncthreads() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__syncwarp(!fir.ref {cuf.data_attr = #cuf.cuda}) attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncwarp", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__threadfence() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__threadfence", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__threadfence_block() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__threadfence_block", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__threadfence_system() attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__threadfence_system", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__syncthreads_and(!fir.ref {cuf.data_attr = #cuf.cuda}) -> i32 attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads_and", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__syncthreads_count(!fir.ref {cuf.data_attr = #cuf.cuda}) -> i32 attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads_count", fir.proc_attrs = #fir.proc_attrs} +! CHECK: func.func private @__syncthreads_or(!fir.ref {cuf.data_attr = #cuf.cuda}) -> i32 attributes {cuf.proc_attr = #cuf.cuda_proc, fir.bindc_name = "__syncthreads_or", fir.proc_attrs = #fir.proc_attrs} diff --git a/flang/test/Lower/HLFIR/bindc-value-derived.f90 b/flang/test/Lower/HLFIR/bindc-value-derived.f90 index a54b29b470e0b4..7a2196dfc8bf12 100644 --- a/flang/test/Lower/HLFIR/bindc-value-derived.f90 +++ b/flang/test/Lower/HLFIR/bindc-value-derived.f90 @@ -14,7 +14,7 @@ subroutine test(x) bind(c) call use_it(x%i) end subroutine ! CHECK-LABEL: func.func @test( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.type<_QMbindc_byvalTt{i:i32}> {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test"} { +! CHECK-SAME: %[[VAL_0:.*]]: !fir.type<_QMbindc_byvalTt{i:i32}> ! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMbindc_byvalTt{i:i32}> ! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref> ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs, uniq_name = "_QMbindc_byvalFtestEx"} : (!fir.ref>, !fir.dscope) -> (!fir.ref>, !fir.ref>) @@ -28,7 +28,7 @@ subroutine call_it(x) call test(x) end subroutine ! CHECK-LABEL: func.func @_QMbindc_byvalPcall_it( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "x"}) { +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QMbindc_byvalFcall_itEx"} : (!fir.ref>, !fir.dscope) -> (!fir.ref>, !fir.ref>) ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref> ! CHECK: fir.call @test(%[[VAL_2]]) proc_attrs fastmath : (!fir.type<_QMbindc_byvalTt{i:i32}>) -> () diff --git a/flang/test/Lower/HLFIR/block_bindc_pocs.f90 b/flang/test/Lower/HLFIR/block_bindc_pocs.f90 index ed07d88c53a606..fc04226dfd23dc 100644 --- a/flang/test/Lower/HLFIR/block_bindc_pocs.f90 +++ b/flang/test/Lower/HLFIR/block_bindc_pocs.f90 @@ -11,7 +11,7 @@ end module m !CHECK-DAG: %[[S0:.*]] = llvm.intr.stacksave : !llvm.ptr !CHECK-DAG: fir.call @test_proc() proc_attrs fastmath : () -> () !CHECK-DAG: llvm.intr.stackrestore %[[S0]] : !llvm.ptr -!CHECK-DAG: func.func private @test_proc() attributes {fir.bindc_name = "test_proc"} +!CHECK-DAG: func.func private @test_proc() attributes {fir.bindc_name = "test_proc", fir.proc_attrs = #fir.proc_attrs} subroutine test BLOCK use m diff --git a/flang/test/Lower/Intrinsics/signal.f90 b/flang/test/Lower/Intrinsics/signal.f90 index 5d20bb5c5c074d..39fef122d77546 100644 --- a/flang/test/Lower/Intrinsics/signal.f90 +++ b/flang/test/Lower/Intrinsics/signal.f90 @@ -4,14 +4,14 @@ module m contains ! CHECK-LABEL: func.func @handler( -! CHECK-SAME: %[[VAL_0:.*]]: i32 {fir.bindc_name = "signum"}) attributes {fir.bindc_name = "handler"} { +! CHECK-SAME: %[[VAL_0:.*]]: i32 subroutine handler(signum) bind(C) use iso_c_binding, only: c_int integer(c_int), value :: signum end subroutine ! CHECK-LABEL: func.func @_QMmPsetup_signals( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "optional_status", fir.optional}) { +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref subroutine setup_signals(optional_status) ! not portable accross systems integer, parameter :: SIGFPE = 8 diff --git a/flang/test/Lower/OpenMP/declare-target-func-and-subr.f90 b/flang/test/Lower/OpenMP/declare-target-func-and-subr.f90 index 0d138321445ce6..3d2c4067dab716 100644 --- a/flang/test/Lower/OpenMP/declare-target-func-and-subr.f90 +++ b/flang/test/Lower/OpenMP/declare-target-func-and-subr.f90 @@ -154,7 +154,7 @@ SUBROUTINE SUBR_DEFAULT_EXTENDEDLIST() !! ----- ! DEVICE-LABEL: func.func @_QPrecursive_declare_target -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}} RECURSIVE FUNCTION RECURSIVE_DECLARE_TARGET(INCREMENT) RESULT(K) !$omp declare target to(RECURSIVE_DECLARE_TARGET) device_type(nohost) INTEGER :: INCREMENT, K @@ -166,7 +166,7 @@ RECURSIVE FUNCTION RECURSIVE_DECLARE_TARGET(INCREMENT) RESULT(K) END FUNCTION RECURSIVE_DECLARE_TARGET ! DEVICE-LABEL: func.func @_QPrecursive_declare_target_enter -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}} RECURSIVE FUNCTION RECURSIVE_DECLARE_TARGET_ENTER(INCREMENT) RESULT(K) !$omp declare target enter(RECURSIVE_DECLARE_TARGET_ENTER) device_type(nohost) INTEGER :: INCREMENT, K diff --git a/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap-enter.f90 b/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap-enter.f90 index 0ca2bcbd66a960..ed718a485e3ddc 100644 --- a/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap-enter.f90 +++ b/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap-enter.f90 @@ -105,7 +105,7 @@ end function target_function_test_host !! ----- ! DEVICE-LABEL: func.func @_QPimplicitly_captured_with_dev_type_recursive -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}}} recursive function implicitly_captured_with_dev_type_recursive(increment) result(k) !$omp declare target enter(implicitly_captured_with_dev_type_recursive) device_type(host) integer :: increment, k @@ -174,7 +174,7 @@ recursive subroutine implicitly_captured_recursive(increment) end program ! DEVICE-LABEL: func.func @_QPimplicitly_captured_recursive -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}}} recursive subroutine implicitly_captured_recursive(increment) integer :: increment if (increment == 10) then diff --git a/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap.f90 b/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap.f90 index ffca5c3ff25000..df81c43a2fe69b 100644 --- a/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap.f90 +++ b/flang/test/Lower/OpenMP/declare-target-implicit-func-and-subr-cap.f90 @@ -131,7 +131,7 @@ end function target_function_test_host !! ----- ! DEVICE-LABEL: func.func @_QPimplicitly_captured_with_dev_type_recursive -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}}} recursive function implicitly_captured_with_dev_type_recursive(increment) result(k) !$omp declare target to(implicitly_captured_with_dev_type_recursive) device_type(host) integer :: increment, k @@ -200,7 +200,7 @@ recursive subroutine implicitly_captured_recursive(increment) end program ! DEVICE-LABEL: func.func @_QPimplicitly_captured_recursive -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}}} recursive subroutine implicitly_captured_recursive(increment) integer :: increment if (increment == 10) then diff --git a/flang/test/Lower/OpenMP/declare-target-implicit-tarop-cap.f90 b/flang/test/Lower/OpenMP/declare-target-implicit-tarop-cap.f90 index 9b85a32036ca52..7d1ae06c80561d 100644 --- a/flang/test/Lower/OpenMP/declare-target-implicit-tarop-cap.f90 +++ b/flang/test/Lower/OpenMP/declare-target-implicit-tarop-cap.f90 @@ -67,7 +67,7 @@ end function target_function_test_device !! ----- ! DEVICE-LABEL: func.func @_QPimplicitly_captured_recursive -! DEVICE-SAME: {{.*}}attributes {fir.func_recursive, omp.declare_target = #omp.declaretarget{{.*}}} +! DEVICE-SAME: {{.*}}attributes {omp.declare_target = #omp.declaretarget{{.*}}} recursive function implicitly_captured_recursive(increment) result(k) integer :: increment, k if (increment == 10) then diff --git a/flang/test/Lower/bindc_procs.f90 b/flang/test/Lower/bindc_procs.f90 index 514f7713c383b5..232e9d809bf179 100644 --- a/flang/test/Lower/bindc_procs.f90 +++ b/flang/test/Lower/bindc_procs.f90 @@ -1,6 +1,6 @@ ! RUN: bbc -emit-fir %s -o - | FileCheck %s -! CHECK-DAG: func.func private @proc1() attributes {fir.bindc_name = "proc1"} +! CHECK-DAG: func.func private @proc1() attributes {fir.bindc_name = "proc1", fir.proc_attrs = #fir.proc_attrs} module decl1 interface subroutine proc_iface() bind(C) @@ -13,7 +13,7 @@ subroutine test1(x) call PrOc1 end subroutine test1 -! CHECK-DAG: func.func private @proc2() attributes {fir.bindc_name = "proc2"} +! CHECK-DAG: func.func private @proc2() attributes {fir.bindc_name = "proc2", fir.proc_attrs = #fir.proc_attrs} module decl2 interface subroutine proc_iface() bind(C) @@ -26,7 +26,7 @@ subroutine test2(x) call PrOc2 end subroutine test2 -! CHECK-DAG: func.func private @func3() -> f32 attributes {fir.bindc_name = "func3"} +! CHECK-DAG: func.func private @func3() -> f32 attributes {fir.bindc_name = "func3", fir.proc_attrs = #fir.proc_attrs} module decl3 interface real function func_iface() bind(C) @@ -40,7 +40,7 @@ subroutine test3(x) x = FuNc3() end subroutine test3 -! CHECK-DAG: func.func private @func4() -> f32 attributes {fir.bindc_name = "func4"} +! CHECK-DAG: func.func private @func4() -> f32 attributes {fir.bindc_name = "func4", fir.proc_attrs = #fir.proc_attrs} module decl4 interface real function func_iface() bind(C) diff --git a/flang/test/Lower/c-interoperability-c-pointer.f90 b/flang/test/Lower/c-interoperability-c-pointer.f90 index 780e3d7dbcb688..9700440f6650b3 100644 --- a/flang/test/Lower/c-interoperability-c-pointer.f90 +++ b/flang/test/Lower/c-interoperability-c-pointer.f90 @@ -32,7 +32,7 @@ subroutine c_func(c_t1, c_t2) bind(c, name="c_func") end ! CHECK-LABEL: func.func @test_callee_c_ptr( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "ptr1"}) attributes {fir.bindc_name = "test_callee_c_ptr"} { +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref ! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_ptrElocal"} ! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> ! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> @@ -56,7 +56,7 @@ subroutine test_callee_c_ptr(ptr1) bind(c) end subroutine ! CHECK-LABEL: func.func @test_callee_c_funptr( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "ptr1"}) attributes {fir.bindc_name = "test_callee_c_funptr"} { +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref ! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_funptrElocal"} ! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> ! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> diff --git a/flang/test/Lower/call.f90 b/flang/test/Lower/call.f90 index 78e9b5f4bc8a79..dc5120c6eb226b 100644 --- a/flang/test/Lower/call.f90 +++ b/flang/test/Lower/call.f90 @@ -45,7 +45,7 @@ function f_int_to_char(i) bind(c, name="f_int_to_char") end function ! CHECK-LABEL: func.func @f_int_to_char( -! CHECK-SAME: %[[ARG0:.*]]: i32 {fir.bindc_name = "i"}) -> !fir.char<1> attributes {fir.bindc_name = "f_int_to_char"} { +! CHECK-SAME: %[[ARG0:.*]]: i32 {fir.bindc_name = "i"}) -> !fir.char<1> attributes {fir.bindc_name = "f_int_to_char", fir.proc_attrs = #fir.proc_attrs} { ! CHECK: %[[CHARBOX:.*]] = fir.alloca !fir.char<1> {adapt.valuebyref} ! CHECK: %[[RESULT:.*]] = fir.alloca !fir.char<1> {bindc_name = "f_int_to_char", uniq_name = "_QFf_int_to_charEf_int_to_char"} ! CHECK: %[[INT_I:.*]] = fir.alloca i32 diff --git a/flang/test/Lower/func-attrs.f90 b/flang/test/Lower/func-attrs.f90 index 7ab549a0ac7ce8..6c1e70bf6dabbe 100644 --- a/flang/test/Lower/func-attrs.f90 +++ b/flang/test/Lower/func-attrs.f90 @@ -3,29 +3,34 @@ pure subroutine sub1() end -! CHECK: func.func @_QPsub1() attributes {fir.func_pure} +! CHECK: func.func @_QPsub1() attributes {fir.proc_attrs = #fir.proc_attrs} elemental subroutine sub2() end -! CHECK: func.func @_QPsub2() attributes {fir.func_elemental, fir.func_pure} +! CHECK: func.func @_QPsub2() attributes {fir.proc_attrs = #fir.proc_attrs} -recursive subroutine sub3() +non_recursive subroutine sub3() end -! CHECK: func.func @_QPsub3() attributes {fir.func_recursive} +! CHECK: func.func @_QPsub3() attributes {fir.proc_attrs = #fir.proc_attrs} + +impure elemental subroutine sub4() +end + +! CHECK: func.func @_QPsub4() attributes {fir.proc_attrs = #fir.proc_attrs} pure function fct1() end -! CHECK: func.func @_QPfct1() -> f32 attributes {fir.func_pure} +! CHECK: func.func @_QPfct1() -> f32 attributes {fir.proc_attrs = #fir.proc_attrs} elemental function fct2() end -! CHECK: func.func @_QPfct2() -> f32 attributes {fir.func_elemental, fir.func_pure} +! CHECK: func.func @_QPfct2() -> f32 attributes {fir.proc_attrs = #fir.proc_attrs} -recursive function fct3() +non_recursive function fct3() end -! CHECK: func.func @_QPfct3() -> f32 attributes {fir.func_recursive} +! CHECK: func.func @_QPfct3() -> f32 attributes {fir.proc_attrs = #fir.proc_attrs} diff --git a/flang/test/Lower/host-associated.f90 b/flang/test/Lower/host-associated.f90 index 67465f5a7073d4..9b4269df7bfcb6 100644 --- a/flang/test/Lower/host-associated.f90 +++ b/flang/test/Lower/host-associated.f90 @@ -309,7 +309,7 @@ subroutine test7(j, k) contains ! CHECK-LABEL: func private @_QFtest7Ptest7_inner( -! CHECK-SAME: %[[i:.*]]: !fir.ref{{.*}}, %[[tup:.*]]: !fir.ref>> {fir.host_assoc}) -> i32 attributes {fir.func_elemental, fir.func_pure, fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage} { +! CHECK-SAME: %[[i:.*]]: !fir.ref{{.*}}, %[[tup:.*]]: !fir.ref>> {fir.host_assoc}) -> i32 attributes {fir.host_symbol = {{.*}}, fir.proc_attrs = #fir.proc_attrs, llvm.linkage = #llvm.linkage} { elemental integer function test7_inner(i) implicit none integer, intent(in) :: i diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 index 002343c45f6ec7..e0af6f065f34da 100644 --- a/flang/test/Lower/program-units-fir-mangling.f90 +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -134,22 +134,22 @@ subroutine should_not_collide() end subroutine end program -! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.bindc_name = "omp_get_num_threads"} { +! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.bindc_name = "omp_get_num_threads", fir.proc_attrs = #fir.proc_attrs} { function omp_get_num_threads() bind(c) ! CHECK: } end function -! CHECK-LABEL: func @get_threads() -> f32 attributes {fir.bindc_name = "get_threads"} { +! CHECK-LABEL: func @get_threads() -> f32 attributes {fir.bindc_name = "get_threads", fir.proc_attrs = #fir.proc_attrs} { function omp_get_num_threads_1() bind(c, name ="get_threads") ! CHECK: } end function -! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.bindc_name = "bEtA"} { +! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.bindc_name = "bEtA", fir.proc_attrs = #fir.proc_attrs} { function alpha() bind(c, name =" bEtA ") ! CHECK: } end function -! CHECK-LABEL: func @bc1() attributes {fir.bindc_name = "bc1"} { +! CHECK-LABEL: func @bc1() attributes {fir.bindc_name = "bc1", fir.proc_attrs = #fir.proc_attrs} { subroutine bind_c_s() Bind(C,Name='bc1') ! CHECK: return end subroutine bind_c_s @@ -175,11 +175,11 @@ subroutine bind_c_s() Bind(C, name='bc1') ! Test that BIND(C) label is taken into account for ENTRY symbols. ! CHECK-LABEL: func @_QPsub_with_entries() { subroutine sub_with_entries -! CHECK-LABEL: func @bar() attributes {fir.bindc_name = "bar"} { +! CHECK-LABEL: func @bar() attributes {fir.bindc_name = "bar", fir.proc_attrs = #fir.proc_attrs} { entry some_entry() bind(c, name="bar") ! CHECK-LABEL: func @_QPnormal_entry() { entry normal_entry() -! CHECK-LABEL: func @some_other_entry() attributes {fir.bindc_name = "some_other_entry"} { +! CHECK-LABEL: func @some_other_entry() attributes {fir.bindc_name = "some_other_entry", fir.proc_attrs = #fir.proc_attrs} { entry some_other_entry() bind(c) end subroutine @@ -196,24 +196,24 @@ subroutine s1() bind(c,name=ok//'2') end subroutine end interface contains -! CHECK-LABEL: func @ok3() -> f32 attributes {fir.bindc_name = "ok3"} { +! CHECK-LABEL: func @ok3() -> f32 attributes {fir.bindc_name = "ok3", fir.proc_attrs = #fir.proc_attrs} { real function f2() bind(c,name=foo//'3') character*(*), parameter :: foo = ok ! CHECK: fir.call @ok1() {{.*}}: () -> f32 -! CHECK-LABEL: func @ok4() -> f32 attributes {fir.bindc_name = "ok4"} { +! CHECK-LABEL: func @ok4() -> f32 attributes {fir.bindc_name = "ok4", fir.proc_attrs = #fir.proc_attrs} { entry f3() bind(c,name=foo//'4') ! CHECK: fir.call @ok1() {{.*}}: () -> f32 f2 = f1() end function -! CHECK-LABEL: func @ok5() attributes {fir.bindc_name = "ok5"} { +! CHECK-LABEL: func @ok5() attributes {fir.bindc_name = "ok5", fir.proc_attrs = #fir.proc_attrs} { subroutine s2() bind(c,name=foo//'5') character*(*), parameter :: foo = ok ! CHECK: fir.call @ok2() {{.*}}: () -> () -! CHECK-LABEL: func @ok6() attributes {fir.bindc_name = "ok6"} { +! CHECK-LABEL: func @ok6() attributes {fir.bindc_name = "ok6", fir.proc_attrs = #fir.proc_attrs} { entry s3() bind(c,name=foo//'6') ! CHECK: fir.call @ok2() {{.*}}: () -> () continue ! force end of specification part -! CHECK-LABEL: func @ok7() attributes {fir.bindc_name = "ok7"} { +! CHECK-LABEL: func @ok7() attributes {fir.bindc_name = "ok7", fir.proc_attrs = #fir.proc_attrs} { entry s4() bind(c,name=foo//'7') ! CHECK: fir.call @ok2() {{.*}}: () -> () call s1