1! RUN: bbc -emit-fir -hlfir=false -outline-intrinsics %s -o - | FileCheck %s 2 3! Test statement function lowering 4 5! Simple case 6 ! CHECK-LABEL: func @_QPtest_stmt_0( 7 ! CHECK-SAME: %{{.*}}: !fir.ref<f32>{{.*}}) -> f32 8real function test_stmt_0(x) 9 real :: x, func, arg 10 func(arg) = arg + 0.123456 11 12 ! CHECK-DAG: %[[x:.*]] = fir.load %arg0 13 ! CHECK-DAG: %[[cst:.*]] = arith.constant 1.234560e-01 14 ! 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 function 21 22! Check this is not lowered as a simple macro: e.g. argument is only 23! evaluated once even if it appears in several placed inside the 24! statement function expression 25! CHECK-LABEL: func @_QPtest_stmt_only_eval_arg_once() -> f32 26real(4) function test_stmt_only_eval_arg_once() 27 real(4) :: only_once, x1 28 func(x1) = x1 + x1 29 ! 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 exposed 32 ! CHECK: fir.store %[[x1]] to %[[x2]] 33 ! CHECK: addf %{{.*}}, %{{.*}} 34 test_stmt_only_eval_arg_once = func(only_once()) 35end function 36 37! Test nested statement function (note that they cannot be recursively 38! nested as per F2018 C1577). 39real function test_stmt_1(x, a) 40 real :: y, a, b, foo 41 real :: func1, arg1, func2, arg2 42 real :: res1, res2 43 func1(arg1) = a + foo(arg1) 44 func2(arg2) = func1(arg2) + b 45 ! 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 = 5 50 51 ! CHECK-DAG: %[[cst_8:.*]] = arith.constant 8.000000e+00 52 ! 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 %arg1 55 ! CHECK: %[[add1:.*]] = arith.addf %[[aload1]], %[[foocall1]] 56 ! CHECK: fir.store %[[add1]] to %[[res1]] 57 res1 = func1(8.) 58 59 ! CHECK-DAG: %[[a2:.*]] = fir.load %arg1 60 ! 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]] {{.*}}: f32 70 test_stmt_1 = res1 + res2 71 ! CHECK: return %{{.*}} : f32 72end function 73 74 75! Test statement functions with no argument. 76! Test that they are not pre-evaluated. 77! CHECK-LABEL: func @_QPtest_stmt_no_args 78real function test_stmt_no_args(x, y) 79 func() = x + y 80 ! CHECK: addf 81 a = func() 82 ! CHECK: fir.call @_QPfoo_may_modify_xy 83 call foo_may_modify_xy(x, y) 84 ! CHECK: addf 85 ! CHECK: addf 86 test_stmt_no_args = func() + a 87end function 88 89! Test statement function with character arguments 90! CHECK-LABEL: @_QPtest_stmt_character 91integer function test_stmt_character(c, j) 92 integer :: i, j, func, argj 93 character(10) :: c, argc 94 ! 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) -> index 99 ! CHECK: %[[c:.*]] = fir.emboxchar %[[ref_cast]], %[[c10_cast]] 100 101 func(argc, argj) = len_trim(argc, 4) + argj 102 ! CHECK: addi %{{.*}}, %{{.*}} : i 103 test_stmt_character = func(c, j) 104end function 105 106 107! Test statement function with a character actual argument whose 108! length may be different than the dummy length (the dummy length 109! 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, ifoo 114 character(10) :: argc 115 character(*) :: c 116 ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] : 117 ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 : 118 ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index 119 ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10_cast]] 120 ! CHECK: fir.call @_QPifoo(%[[argc]]) {{.*}}: (!fir.boxchar<1>) -> i32 121 func(argc) = ifoo(argc) 122 test_stmt_character = func(c) 123end function 124 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, ifoo 129 character(n) :: argc 130 character(*) :: c 131 ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] : 132 ! CHECK: fir.load %[[arg1]] : !fir.ref<i32> 133 ! CHECK: %[[n:.*]] = fir.load %[[arg1]] : !fir.ref<i32> 134 ! CHECK: %[[n_is_positive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32 135 ! CHECK: %[[len:.*]] = arith.select %[[n_is_positive]], %[[n]], %c0{{.*}} : i32 136 ! CHECK: %[[lenCast:.*]] = fir.convert %[[len]] : (i32) -> index 137 ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[lenCast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1> 138 ! CHECK: fir.call @_QPifoo(%[[argc]]) {{.*}}: (!fir.boxchar<1>) -> i32 139 func(argc) = ifoo(argc) 140 test_stmt_character = func(c) 141end function 142 143! issue #247 144! CHECK-LABEL: @_QPbug247 145subroutine bug247(r) 146 I(R) = R 147 ! CHECK: fir.call {{.*}}OutputInteger 148 PRINT *, I(2.5) 149 ! CHECK: fir.call {{.*}}EndIo 150END subroutine bug247 151 152! Test that the argument is truncated to the length of the dummy argument. 153subroutine truncate_arg 154 character(4) arg 155 character(10) stmt_fct 156 stmt_fct(arg) = arg 157 print *, stmt_fct('longer_arg') 158end subroutine 159 160! CHECK-LABEL: @_QPtruncate_arg 161! CHECK: %[[c4:.*]] = arith.constant 4 : i32 162! CHECK: %[[arg:.*]] = fir.address_of(@_QQclX{{.*}}) : !fir.ref<!fir.char<1,10>> 163! CHECK: %[[cast_arg:.*]] = fir.convert %[[arg]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>> 164! CHECK: %[[c10:.*]] = arith.constant 10 : i64 165! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".chrtmp"} 166! CHECK: %[[c10_index:.*]] = fir.convert %[[c10]] : (i64) -> index 167! CHECK: %[[c4_index:.*]] = fir.convert %[[c4]] : (i32) -> index 168! CHECK: %[[cmpi:.*]] = arith.cmpi slt, %[[c10_index]], %[[c4_index]] : index 169! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[c10_index]], %[[c4_index]] : index 170! CHECK: %[[c1:.*]] = arith.constant 1 : i64 171! CHECK: %[[select_i64:.*]] = fir.convert %[[select]] : (index) -> i64 172! CHECK: %[[length:.*]] = arith.muli %[[c1]], %[[select_i64]] : i64 173! CHECK: %[[cast_temp_i8:.*]] = fir.convert %[[temp]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8> 174! CHECK: %[[cast_arg_i8:.*]] = fir.convert %[[cast_arg]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8> 175! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[cast_temp_i8]], %[[cast_arg_i8]], %[[length]], %{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 176! CHECK: %[[c1_i64:.*]] = arith.constant 1 : i64 177! CHECK: %[[ub:.*]] = arith.subi %[[c10]], %[[c1_i64]] : i64 178! CHECK: %[[ub_index:.*]] = fir.convert %[[ub]] : (i64) -> index 179! CHECK: fir.do_loop %{{.*}} = %[[select]] to %[[ub_index]] step %{{.*}} { 180! CHECK: %[[cast_temp:.*]] = fir.convert %[[temp:.*]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8> 181! CHECK: %{{.*}} = fir.call @_FortranAioOutputAscii(%{{.*}}, %[[cast_temp]], %[[c10]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 182