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
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: %[[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)
102end function
103
104! Test statement function with a character actual argument whose
105! length may be different than the dummy length (the dummy length
106! must be used inside the statement function).
107! CHECK-LABEL: @_QPtest_stmt_character_with_different_length(
108! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>
109integer function test_stmt_character_with_different_length(c)
110  integer :: func, ifoo
111  character(10) :: argc
112  character(*) :: c
113  ! CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] :
114  ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 :
115  ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index
116  ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10_cast]]
117  ! CHECK: fir.call @_QPifoo(%[[argc]]) : (!fir.boxchar<1>) -> i32
118  func(argc) = ifoo(argc)
119  test_stmt_character = func(c)
120end function
121
122! CHECK-LABEL: @_QPtest_stmt_character_with_different_length_2(
123! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>
124integer function test_stmt_character_with_different_length_2(c, n)
125  integer :: func, ifoo
126  character(n) :: argc
127  character(*) :: c
128  ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] :
129  ! CHECK: fir.load %[[arg1]] : !fir.ref<i32>
130  ! CHECK: %[[n:.*]] = fir.load %[[arg1]] : !fir.ref<i32>
131  ! CHECK: %[[n_is_positive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32
132  ! CHECK: %[[len:.*]] = arith.select %[[n_is_positive]], %[[n]], %c0{{.*}} : i32
133  ! CHECK: %[[lenCast:.*]] = fir.convert %[[len]] : (i32) -> index
134  ! CHECK: %[[argc:.*]] = fir.emboxchar %[[unboxed]]#0, %[[lenCast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
135  ! CHECK: fir.call @_QPifoo(%[[argc]]) : (!fir.boxchar<1>) -> i32
136  func(argc) = ifoo(argc)
137  test_stmt_character = func(c)
138end function
139
140! issue #247
141! CHECK-LABEL: @_QPbug247
142subroutine bug247(r)
143  I(R) = R
144  ! CHECK: fir.call {{.*}}OutputInteger
145  PRINT *, I(2.5)
146  ! CHECK: fir.call {{.*}}EndIo
147END subroutine bug247
148