flang/test/Lower/statement-function.f90

   1 ! RUN: bbc -emit-fir -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
   8 real 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]]
  20 end 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
  26 real(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())
  35 end function
  36
  37 ! Test nested statement function (note that they cannot be recursively
  38 ! nested as per F2018 C1577).
  39 real 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
  72 end 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
  78 real 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
  87 end function
  88
  89 ! Test statement function with character arguments
  90 ! CHECK-LABEL: @_QPtest_stmt_character
  91 integer 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: %[[c10:.*]] = arith.constant 10 :
  96   ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index
  97   ! CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10_cast]]
  98
  99   func(argc, argj) = len_trim(argc, 4) + argj
 100   ! CHECK: addi %{{.*}}, %{{.*}} : i
 101   test_stmt_character = func(c, j)
 102 end function
 103
 104
 105 ! Test statement function with a character actual argument whose
 106 ! length may be different than the dummy length (the dummy length
 107 ! must be used inside the statement function).
 108 ! CHECK-LABEL: @_QPtest_stmt_character_with_different_length(
 109 ! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>
 110 integer function test_stmt_character_with_different_length(c)
 111   integer :: func, ifoo
 112   character(10) :: argc
 113   character(*) :: c
 114   ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] :
 115   ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 :
 116   ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index
 117   ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10_cast]]
 118   ! CHECK: fir.call @_QPifoo(%[[argc]]) {{.*}}: (!fir.boxchar<1>) -> i32
 119   func(argc) = ifoo(argc)
 120   test_stmt_character = func(c)
 121 end function
 122
 123 ! CHECK-LABEL: @_QPtest_stmt_character_with_different_length_2(
 124 ! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>
 125 integer function test_stmt_character_with_different_length_2(c, n)
 126   integer :: func, ifoo
 127   character(n) :: argc
 128   character(*) :: c
 129   ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] :
 130   ! CHECK: fir.load %[[arg1]] : !fir.ref<i32>
 131   ! CHECK: %[[n:.*]] = fir.load %[[arg1]] : !fir.ref<i32>
 132   ! CHECK: %[[n_is_positive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32
 133   ! CHECK: %[[len:.*]] = arith.select %[[n_is_positive]], %[[n]], %c0{{.*}} : i32
 134   ! CHECK: %[[lenCast:.*]] = fir.convert %[[len]] : (i32) -> index
 135   ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[lenCast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
 136   ! CHECK: fir.call @_QPifoo(%[[argc]]) {{.*}}: (!fir.boxchar<1>) -> i32
 137   func(argc) = ifoo(argc)
 138   test_stmt_character = func(c)
 139 end function
 140
 141 ! issue #247
 142 ! CHECK-LABEL: @_QPbug247
 143 subroutine bug247(r)
 144   I(R) = R
 145   ! CHECK: fir.call {{.*}}OutputInteger
 146   PRINT *, I(2.5)
 147   ! CHECK: fir.call {{.*}}EndIo
 148 END subroutine bug247
 149
 150 ! Test that the argument is truncated to the length of the dummy argument.
 151 subroutine truncate_arg
 152   character(4) arg
 153   character(10) stmt_fct
 154   stmt_fct(arg) = arg
 155   print *, stmt_fct('longer_arg')
 156 end subroutine
 157
 158 ! CHECK-LABEL: @_QPtruncate_arg
 159 ! CHECK: %[[c4:.*]] = arith.constant 4 : i32
 160 ! CHECK: %[[arg:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,10>>
 161 ! CHECK: %[[cast_arg:.*]] = fir.convert %[[arg]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
 162 ! CHECK: %[[c10:.*]] = arith.constant 10 : i64
 163 ! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".chrtmp"}
 164 ! CHECK: %[[c10_index:.*]] = fir.convert %[[c10]] : (i64) -> index
 165 ! CHECK: %[[c4_index:.*]] = fir.convert %[[c4]] : (i32) -> index
 166 ! CHECK: %[[cmpi:.*]] = arith.cmpi slt, %[[c10_index]], %[[c4_index]] : index
 167 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[c10_index]], %[[c4_index]] : index
 168 ! CHECK: %[[c1:.*]] = arith.constant 1 : i64
 169 ! CHECK: %[[select_i64:.*]] = fir.convert %[[select]] : (index) -> i64
 170 ! CHECK: %[[length:.*]] = arith.muli %[[c1]], %[[select_i64]] : i64
 171 ! CHECK: %[[cast_temp_i8:.*]] = fir.convert %[[temp]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
 172 ! CHECK: %[[cast_arg_i8:.*]] = fir.convert %[[cast_arg]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
 173 ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[cast_temp_i8]], %[[cast_arg_i8]], %[[length]], %{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
 174 ! CHECK: %[[c1_i64:.*]] = arith.constant 1 : i64
 175 ! CHECK: %[[ub:.*]] = arith.subi %[[c10]], %[[c1_i64]] : i64
 176 ! CHECK: %[[ub_index:.*]] = fir.convert %[[ub]] : (i64) -> index
 177 ! CHECK: fir.do_loop %{{.*}} = %[[select]] to %[[ub_index]] step %{{.*}} {
 178 ! CHECK: %[[cast_temp:.*]] = fir.convert %[[temp:.*]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
 179 ! CHECK: %{{.*}} = fir.call @_FortranAioOutputAscii(%{{.*}}, %[[cast_temp]], %[[c10]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1