181 lines · plain
1! RUN: bbc -emit-fir -hlfir=false -outline-intrinsics %s -o - | FileCheck %s2 3! Test statement function lowering4 5! Simple case6 ! CHECK-LABEL: func @_QPtest_stmt_0(7 ! CHECK-SAME: %{{.*}}: !fir.ref<f32>{{.*}}) -> f328real function test_stmt_0(x)9 real :: x, func, arg10 func(arg) = arg + 0.12345611 12 ! CHECK-DAG: %[[x:.*]] = fir.load %arg013 ! CHECK-DAG: %[[cst:.*]] = arith.constant 1.234560e-0114 ! CHECK: %[[eval:.*]] = arith.addf %[[x]], %[[cst]]15 ! CHECK: fir.store %[[eval]] to %[[resmem:.*]] : !fir.ref<f32>16 test_stmt_0 = func(x)17 18 ! CHECK: %[[res:.*]] = fir.load %[[resmem]]19 ! CHECK: return %[[res]]20end function21 22! Check this is not lowered as a simple macro: e.g. argument is only23! evaluated once even if it appears in several placed inside the24! statement function expression25! CHECK-LABEL: func @_QPtest_stmt_only_eval_arg_once() -> f3226real(4) function test_stmt_only_eval_arg_once()27 real(4) :: only_once, x128 func(x1) = x1 + x129 ! CHECK: %[[x2:.*]] = fir.alloca f32 {adapt.valuebyref}30 ! CHECK: %[[x1:.*]] = fir.call @_QPonly_once()31 ! Note: using -emit-fir, so the faked pass-by-reference is exposed32 ! CHECK: fir.store %[[x1]] to %[[x2]]33 ! CHECK: addf %{{.*}}, %{{.*}}34 test_stmt_only_eval_arg_once = func(only_once())35end function36 37! Test nested statement function (note that they cannot be recursively38! nested as per F2018 C1577).39real function test_stmt_1(x, a)40 real :: y, a, b, foo41 real :: func1, arg1, func2, arg242 real :: res1, res243 func1(arg1) = a + foo(arg1)44 func2(arg2) = func1(arg2) + b45 ! CHECK-DAG: %[[bmem:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Eb"}46 ! CHECK-DAG: %[[res1:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Eres1"}47 ! CHECK-DAG: %[[res2:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Eres2"}48 49 b = 550 51 ! CHECK-DAG: %[[cst_8:.*]] = arith.constant 8.000000e+0052 ! CHECK-DAG: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref<f32>53 ! CHECK-DAG: %[[foocall1:.*]] = fir.call @_QPfoo(%[[tmp1]])54 ! CHECK-DAG: %[[aload1:.*]] = fir.load %arg155 ! CHECK: %[[add1:.*]] = arith.addf %[[aload1]], %[[foocall1]]56 ! CHECK: fir.store %[[add1]] to %[[res1]]57 res1 = func1(8.)58 59 ! CHECK-DAG: %[[a2:.*]] = fir.load %arg160 ! CHECK-DAG: %[[foocall2:.*]] = fir.call @_QPfoo(%arg0)61 ! CHECK-DAG: %[[add2:.*]] = arith.addf %[[a2]], %[[foocall2]]62 ! CHECK-DAG: %[[b:.*]] = fir.load %[[bmem]]63 ! CHECK: %[[add3:.*]] = arith.addf %[[add2]], %[[b]]64 ! CHECK: fir.store %[[add3]] to %[[res2]]65 res2 = func2(x)66 67 ! CHECK-DAG: %[[res12:.*]] = fir.load %[[res1]]68 ! CHECK-DAG: %[[res22:.*]] = fir.load %[[res2]]69 ! CHECK: = arith.addf %[[res12]], %[[res22]] {{.*}}: f3270 test_stmt_1 = res1 + res271 ! CHECK: return %{{.*}} : f3272end function73 74 75! Test statement functions with no argument.76! Test that they are not pre-evaluated.77! CHECK-LABEL: func @_QPtest_stmt_no_args78real function test_stmt_no_args(x, y)79 func() = x + y80 ! CHECK: addf81 a = func()82 ! CHECK: fir.call @_QPfoo_may_modify_xy83 call foo_may_modify_xy(x, y)84 ! CHECK: addf85 ! CHECK: addf86 test_stmt_no_args = func() + a87end function88 89! Test statement function with character arguments90! CHECK-LABEL: @_QPtest_stmt_character91integer function test_stmt_character(c, j)92 integer :: i, j, func, argj93 character(10) :: c, argc94 ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 :95 ! CHECK-DAG: %[[ref:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,10>>96 ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 :97 ! CHECK-DAG: %[[ref_cast:.*]] = fir.convert %[[ref]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>98 ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index99 ! CHECK: %[[c:.*]] = fir.emboxchar %[[ref_cast]], %[[c10_cast]]100 101 func(argc, argj) = len_trim(argc, 4) + argj102 ! CHECK: addi %{{.*}}, %{{.*}} : i103 test_stmt_character = func(c, j)104end function105 106 107! Test statement function with a character actual argument whose108! length may be different than the dummy length (the dummy length109! must be used inside the statement function).110! CHECK-LABEL: @_QPtest_stmt_character_with_different_length(111! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>112integer function test_stmt_character_with_different_length(c)113 integer :: func, ifoo114 character(10) :: argc115 character(*) :: c116 ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] :117 ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 :118 ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index119 ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10_cast]]120 ! CHECK: fir.call @_QPifoo(%[[argc]]) {{.*}}: (!fir.boxchar<1>) -> i32121 func(argc) = ifoo(argc)122 test_stmt_character = func(c)123end function124 125! CHECK-LABEL: @_QPtest_stmt_character_with_different_length_2(126! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>127integer function test_stmt_character_with_different_length_2(c, n)128 integer :: func, ifoo129 character(n) :: argc130 character(*) :: c131 ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] :132 ! CHECK: %[[n:.*]] = fir.load %[[arg1]] : !fir.ref<i32>133 ! CHECK: %[[n_is_positive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32134 ! CHECK: %[[len:.*]] = arith.select %[[n_is_positive]], %[[n]], %c0{{.*}} : i32135 ! CHECK: %[[lenCast:.*]] = fir.convert %[[len]] : (i32) -> index136 ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[lenCast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>137 ! CHECK: fir.call @_QPifoo(%[[argc]]) {{.*}}: (!fir.boxchar<1>) -> i32138 func(argc) = ifoo(argc)139 test_stmt_character = func(c)140end function141 142! issue #247143! CHECK-LABEL: @_QPbug247144subroutine bug247(r)145 I(R) = R146 ! CHECK: fir.call {{.*}}OutputInteger147 PRINT *, I(2.5)148 ! CHECK: fir.call {{.*}}EndIo149END subroutine bug247150 151! Test that the argument is truncated to the length of the dummy argument.152subroutine truncate_arg153 character(4) arg154 character(10) stmt_fct155 stmt_fct(arg) = arg156 print *, stmt_fct('longer_arg')157end subroutine158 159! CHECK-LABEL: @_QPtruncate_arg160! CHECK: %[[c4:.*]] = arith.constant 4 : i32161! CHECK: %[[arg:.*]] = fir.address_of(@_QQclX{{.*}}) : !fir.ref<!fir.char<1,10>>162! CHECK: %[[cast_arg:.*]] = fir.convert %[[arg]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>163! CHECK: %[[c10:.*]] = arith.constant 10 : i64164! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".chrtmp"}165! CHECK: %[[c10_index:.*]] = fir.convert %[[c10]] : (i64) -> index166! CHECK: %[[c4_index:.*]] = fir.convert %[[c4]] : (i32) -> index167! CHECK: %[[cmpi:.*]] = arith.cmpi slt, %[[c10_index]], %[[c4_index]] : index168! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[c10_index]], %[[c4_index]] : index169! CHECK: %[[c1:.*]] = arith.constant 1 : i64170! CHECK: %[[select_i64:.*]] = fir.convert %[[select]] : (index) -> i64171! CHECK: %[[length:.*]] = arith.muli %[[c1]], %[[select_i64]] : i64172! CHECK: %[[cast_temp_i8:.*]] = fir.convert %[[temp]] : (!fir.ref<!fir.char<1,10>>) -> !llvm.ptr173! CHECK: %[[cast_arg_i8:.*]] = fir.convert %[[cast_arg]] : (!fir.ref<!fir.char<1,?>>) -> !llvm.ptr174! CHECK: "llvm.intr.memmove"(%[[cast_temp_i8]], %[[cast_arg_i8]], %[[length]]) <{isVolatile = false}> : (!llvm.ptr, !llvm.ptr, i64) -> ()175! CHECK: %[[c1_i64:.*]] = arith.constant 1 : i64176! CHECK: %[[ub:.*]] = arith.subi %[[c10]], %[[c1_i64]] : i64177! CHECK: %[[ub_index:.*]] = fir.convert %[[ub]] : (i64) -> index178! CHECK: fir.do_loop %{{.*}} = %[[select]] to %[[ub_index]] step %{{.*}} {179! CHECK: %[[cast_temp:.*]] = fir.convert %[[temp:.*]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>180! CHECK: %{{.*}} = fir.call @_FortranAioOutputAscii(%{{.*}}, %[[cast_temp]], %[[c10]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1181