1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
! RUN: bbc -emit-fir %s -o - | FileCheck %s
! Test dummy procedures
! Test of dummy procedure call
! CHECK-LABEL: func @_QPfoo(
! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) -> f32
real function foo(bar)
real :: bar, x
! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"}
x = 42.
! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> f32)
! CHECK: fir.call %[[funccast]](%[[x]]) {{.*}}: (!fir.ref<f32>) -> f32
foo = bar(x)
end function
! Test case where dummy procedure is only transiting.
! CHECK-LABEL: func @_QPprefoo(
! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) -> f32
real function prefoo(bar)
external :: bar
! CHECK: fir.call @_QPfoo(%arg0) {{.*}}: (!fir.boxproc<() -> ()>) -> f32
prefoo = foo(bar)
end function
! Function that will be passed as dummy argument
! CHECK-LABEL: func @_QPfunc(
! CHECK-SAME: %{{.*}}: !fir.ref<f32>{{.*}}) -> f32
real function func(x)
real :: x
func = x + 0.5
end function
! Test passing functions as dummy procedure arguments
! CHECK-LABEL: func @_QPtest_func
real function test_func()
real :: func, prefoo
external :: func
!CHECK: %[[f:.*]] = fir.address_of(@_QPfunc) : (!fir.ref<f32>) -> f32
!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
!CHECK: fir.call @_QPprefoo(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> f32
test_func = prefoo(func)
end function
! Repeat test with dummy subroutine
! CHECK-LABEL: func @_QPfoo_sub(
! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}})
subroutine foo_sub(bar_sub)
! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"}
x = 42.
! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> ())
! CHECK: fir.call %[[funccast]](%[[x]]) {{.*}}: (!fir.ref<f32>)
call bar_sub(x)
end subroutine
! Test case where dummy procedure is only transiting.
! CHECK-LABEL: func @_QPprefoo_sub(
! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}})
subroutine prefoo_sub(bar_sub)
external :: bar_sub
! CHECK: fir.call @_QPfoo_sub(%arg0) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call foo_sub(bar_sub)
end subroutine
! Subroutine that will be passed as dummy argument
! CHECK-LABEL: func @_QPsub(
! CHECK-SAME: %{{.*}}: !fir.ref<f32>{{.*}})
subroutine sub(x)
real :: x
print *, x
end subroutine
! Test passing functions as dummy procedure arguments
! CHECK-LABEL: func @_QPtest_sub
subroutine test_sub()
external :: sub
!CHECK: %[[f:.*]] = fir.address_of(@_QPsub) : (!fir.ref<f32>) -> ()
!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>) -> ()) -> !fir.boxproc<() -> ()>
!CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call prefoo_sub(sub)
end subroutine
! CHECK-LABEL: func @_QPpassing_not_defined_in_file()
subroutine passing_not_defined_in_file()
external proc_not_defined_in_file
! CHECK: %[[addr:.*]] = fir.address_of(@_QPproc_not_defined_in_file) : () -> ()
! CHECK: %[[ep:.*]] = fir.emboxproc %[[addr]]
! CHECK: fir.call @_QPprefoo_sub(%[[ep]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call prefoo_sub(proc_not_defined_in_file)
end subroutine
! Test passing unrestricted intrinsics
! Intrinsic using runtime
! CHECK-LABEL: func @_QPtest_acos
subroutine test_acos(x)
intrinsic :: acos
!CHECK: %[[f:.*]] = fir.address_of(@fir.acos.f32.ref_f32) : (!fir.ref<f32>) -> f32
!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
!CHECK: fir.call @_QPfoo_acos(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call foo_acos(acos)
end subroutine
! CHECK-LABEL: func @_QPtest_atan2
subroutine test_atan2()
intrinsic :: atan2
! CHECK: %[[f:.*]] = fir.address_of(@fir.atan2.f32.ref_f32.ref_f32) : (!fir.ref<f32>, !fir.ref<f32>) -> f32
! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>, !fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
! CHECK: fir.call @_QPfoo_atan2(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call foo_atan2(atan2)
end subroutine
! Intrinsic implemented inlined
! CHECK-LABEL: func @_QPtest_aimag
subroutine test_aimag()
intrinsic :: aimag
!CHECK: %[[f:.*]] = fir.address_of(@fir.aimag.f32.ref_z4) : (!fir.ref<!fir.complex<4>>) -> f32
!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<!fir.complex<4>>) -> f32) -> !fir.boxproc<() -> ()>
!CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call foo_aimag(aimag)
end subroutine
! Character Intrinsic implemented inlined
! CHECK-LABEL: func @_QPtest_len
subroutine test_len()
intrinsic :: len
! CHECK: %[[f:.*]] = fir.address_of(@fir.len.i32.bc1) : (!fir.boxchar<1>) -> i32
! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.boxchar<1>) -> i32) -> !fir.boxproc<() -> ()>
!CHECK: fir.call @_QPfoo_len(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call foo_len(len)
end subroutine
! Intrinsic implemented inlined with specific name different from generic
! CHECK-LABEL: func @_QPtest_iabs
subroutine test_iabs()
intrinsic :: iabs
! CHECK: %[[f:.*]] = fir.address_of(@fir.abs.i32.ref_i32) : (!fir.ref<i32>) -> i32
! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<i32>) -> i32) -> !fir.boxproc<() -> ()>
! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
call foo_iabs(iabs)
end subroutine
! TODO: exhaustive test of unrestricted intrinsic table 16.2
! TODO: improve dummy procedure types when interface is given.
! CHECK: func @_QPtodo3(
! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}})
! SHOULD-CHECK: func @_QPtodo3(%arg0: (!fir.ref<f32>) -> f32)
subroutine todo3(dummy_proc)
intrinsic :: acos
procedure(acos) :: dummy_proc
end subroutine
! CHECK-LABEL: func private @fir.acos.f32.ref_f32(%arg0: !fir.ref<f32>) -> f32
!CHECK: %[[load:.*]] = fir.load %arg0
!CHECK: %[[res:.*]] = fir.call @acosf(%[[load]]) fastmath<contract> : (f32) -> f32
!CHECK: return %[[res]] : f32
! CHECK-LABEL: func private @fir.atan2.f32.ref_f32.ref_f32(
! CHECK-SAME: %[[x:.*]]: !fir.ref<f32>, %[[y:.*]]: !fir.ref<f32>) -> f32
! CHECK-DAG: %[[xload:.*]] = fir.load %[[x]] : !fir.ref<f32>
! CHECK-DAG: %[[yload:.*]] = fir.load %[[y]] : !fir.ref<f32>
! CHECK: %[[atan2:.*]] = math.atan2 %[[xload]], %[[yload]] fastmath<contract> : f32
! CHECK: return %[[atan2]] : f32
!CHECK-LABEL: func private @fir.aimag.f32.ref_z4(%arg0: !fir.ref<!fir.complex<4>>)
!CHECK: %[[load:.*]] = fir.load %arg0
!CHECK: %[[imag:.*]] = fir.extract_value %[[load]], [1 : index] : (!fir.complex<4>) -> f32
!CHECK: return %[[imag]] : f32
!CHECK-LABEL: func private @fir.len.i32.bc1(%arg0: !fir.boxchar<1>)
!CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
!CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32
!CHECK: return %[[len]] : i32
|
