-
Notifications
You must be signed in to change notification settings - Fork 132
/
defcfun.lisp
361 lines (301 loc) · 13.9 KB
/
defcfun.lisp
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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; defcfun.lisp --- Tests function definition and calling.
;;;
;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
;;;
(in-package #:cffi-tests)
;;;# Calling with built-in c types
;;;
;;; Tests calling standard C library functions both passing
;;; and returning each built-in type. (adapted from funcall.lisp)
(defcfun "toupper" :char
(char :char))
(deftest defcfun.char
(toupper (char-code #\a))
#.(char-code #\A))
(defcfun ("abs" c-abs) :int
(n :int))
(deftest defcfun.int
(c-abs -100)
100)
(defcfun "labs" :long
(n :long))
(deftest defcfun.long
(labs -131072)
131072)
#-cffi-features:no-long-long
(progn
(defcfun "my_llabs" :long-long
(n :long-long))
(deftest defcfun.long-long
(my-llabs -9223372036854775807)
9223372036854775807))
(defcfun "my_sqrtf" :float
(n :float))
(deftest defcfun.float
(my-sqrtf 16.0)
4.0)
(defcfun ("sqrt" c-sqrt) :double
(n :double))
(deftest defcfun.double
(c-sqrt 36.0d0)
6.0d0)
#+(and scl long-float)
(defcfun ("sqrtl" c-sqrtl) :long-double
(n :long-double))
#+(and scl long-float)
(deftest defcfun.long-double
(c-sqrtl 36.0l0)
6.0l0)
(defcfun "strlen" :int
(n :string))
(deftest defcfun.string.1
(strlen "Hello")
5)
(defcfun "strcpy" (:pointer :char)
(dest (:pointer :char))
(src :string))
(defcfun "strcat" (:pointer :char)
(dest (:pointer :char))
(src :string))
(deftest defcfun.string.2
(with-foreign-pointer-as-string (s 100)
(setf (mem-ref s :char) 0)
(strcpy s "Hello")
(strcat s ", world!"))
"Hello, world!")
(defcfun "strerror" :string
(n :int))
(deftest defcfun.string.3
(typep (strerror 1) 'string)
t)
;;; Regression test. Allegro would warn on direct calls to
;;; functions with no arguments.
;;; Also, let's check if void functions will return NIL.
(defcfun "noargs" :int)
(deftest defcfun.noargs
(noargs)
42)
(defcfun "noop" :void)
(deftest defcfun.noop
(noop)
nil)
;;;# Calling varargs functions
(defcfun "sprintf" :int
(str (:pointer :char))
(control :string)
&rest)
(deftest defcfun.varargs.char
(with-foreign-pointer-as-string (s 100)
(sprintf s "%c" :char 65))
"A")
(deftest defcfun.varargs.short
(with-foreign-pointer-as-string (s 100)
(sprintf s "%d" :short 42))
"42")
(deftest defcfun.varargs.int
(with-foreign-pointer-as-string (s 100)
(sprintf s "%d" :int 1000))
"1000")
(deftest defcfun.varargs.long
(with-foreign-pointer-as-string (s 100)
(sprintf s "%ld" :long 131072))
"131072")
(deftest defcfun.varargs.float
(with-foreign-pointer-as-string (s 100)
(sprintf s "%.2f" :float (float pi)))
"3.14")
(deftest defcfun.varargs.double
(with-foreign-pointer-as-string (s 100)
(sprintf s "%.2f" :double (float pi 1.0d0)))
"3.14")
#+(and scl long-float)
(deftest defcfun.varargs.long-double
(with-foreign-pointer-as-string (s 100)
(setf (mem-ref s :char) 0)
(sprintf s "%.2Lf" :long-double pi))
"3.14")
(deftest defcfun.varargs.string
(with-foreign-pointer-as-string (s 100)
(sprintf s "%s, %s!" :string "Hello" :string "world"))
"Hello, world!")
;;; (let ((rettype (find-type :long))
;;; (arg-types (n-random-types-no-ll 127)))
;;; (c-function rettype arg-types)
;;; (gen-function-test rettype arg-types))
#+#.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))
(progn
(defcfun "sum_127_no_ll" :long
(a1 :long) (a2 :unsigned-long) (a3 :short) (a4 :unsigned-short) (a5 :float)
(a6 :double) (a7 :unsigned-long) (a8 :float) (a9 :unsigned-char)
(a10 :unsigned-short) (a11 :short) (a12 :unsigned-long) (a13 :double)
(a14 :long) (a15 :unsigned-int) (a16 :pointer) (a17 :unsigned-int)
(a18 :unsigned-short) (a19 :long) (a20 :float) (a21 :pointer) (a22 :float)
(a23 :int) (a24 :int) (a25 :unsigned-short) (a26 :long) (a27 :long)
(a28 :double) (a29 :unsigned-char) (a30 :unsigned-int) (a31 :unsigned-int)
(a32 :int) (a33 :unsigned-short) (a34 :unsigned-int) (a35 :pointer)
(a36 :double) (a37 :double) (a38 :long) (a39 :short) (a40 :unsigned-short)
(a41 :long) (a42 :char) (a43 :long) (a44 :unsigned-short) (a45 :pointer)
(a46 :int) (a47 :unsigned-int) (a48 :double) (a49 :unsigned-char)
(a50 :unsigned-char) (a51 :float) (a52 :int) (a53 :unsigned-short)
(a54 :double) (a55 :short) (a56 :unsigned-char) (a57 :unsigned-long)
(a58 :float) (a59 :float) (a60 :float) (a61 :pointer) (a62 :pointer)
(a63 :unsigned-int) (a64 :unsigned-long) (a65 :char) (a66 :short)
(a67 :unsigned-short) (a68 :unsigned-long) (a69 :pointer) (a70 :float)
(a71 :double) (a72 :long) (a73 :unsigned-long) (a74 :short)
(a75 :unsigned-int) (a76 :unsigned-short) (a77 :int) (a78 :unsigned-short)
(a79 :char) (a80 :double) (a81 :short) (a82 :unsigned-char) (a83 :float)
(a84 :char) (a85 :int) (a86 :double) (a87 :unsigned-char) (a88 :int)
(a89 :unsigned-long) (a90 :double) (a91 :short) (a92 :short)
(a93 :unsigned-int) (a94 :unsigned-char) (a95 :float) (a96 :long)
(a97 :float) (a98 :long) (a99 :long) (a100 :int) (a101 :int)
(a102 :unsigned-int) (a103 :char) (a104 :char) (a105 :unsigned-short)
(a106 :unsigned-int) (a107 :unsigned-short) (a108 :unsigned-short)
(a109 :int) (a110 :long) (a111 :char) (a112 :double) (a113 :unsigned-int)
(a114 :char) (a115 :short) (a116 :unsigned-long) (a117 :unsigned-int)
(a118 :short) (a119 :unsigned-char) (a120 :float) (a121 :pointer)
(a122 :double) (a123 :int) (a124 :long) (a125 :char) (a126 :unsigned-short)
(a127 :float))
(deftest defcfun.bff.1
(sum-127-no-ll
1442906394 520035521 -4715 50335 -13557.0 -30892.0d0 24061483 -23737.0
22 2348 4986 104895680 8073.0d0 -571698147 102484400
(make-pointer 507907275) 12733353 7824 -1275845284 13602.0
(make-pointer 286958390) -8042.0 -773681663 -1289932452 31199 -154985357
-170994216 16845.0d0 177 218969221 2794350893 6068863 26327 127699339
(make-pointer 184352771) 18512.0d0 -12345.0d0 -179853040 -19981 37268
-792845398 116 -1084653028 50494 (make-pointer 2105239646) -1710519651
1557813312 2839.0d0 90 180 30580.0 -532698978 8623 9537.0d0 -10882 54
184357206 14929.0 -8190.0 -25615.0 (make-pointer 235310526)
(make-pointer 220476977) 7476055 1576685 -117 -11781 31479 23282640
(make-pointer 8627281) -17834.0 10391.0d0 -1904504370 114393659 -17062
637873619 16078 -891210259 8107 0 760.0d0 -21268 104 14133.0 10
588598141 310.0d0 20 1351785456 16159552 -10121.0d0 -25866 24821
68232851 60 -24132.0 -1660411658 13387.0 -786516668 -499825680
-1128144619 111849719 2746091587 -2 95 14488 326328135 64781 18204
150716680 -703859275 103 16809.0d0 852235610 -43 21088 242356110
324325428 -22380 23 24814.0 (make-pointer 40362014) -14322.0d0
-1864262539 523684371 -21 49995 -29175.0) 796447501))
;;; (let ((rettype (find-type :long-long))
;;; (arg-types (n-random-types 127)))
;;; (c-function rettype arg-types)
;;; (gen-function-test rettype arg-types))
#-(:or cffi-features:no-long-long
#.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:or) '(:and)))
(progn
(defcfun "sum_127" :long-long
(a1 :pointer) (a2 :pointer) (a3 :float) (a4 :unsigned-long) (a5 :pointer)
(a6 :long-long) (a7 :double) (a8 :double) (a9 :unsigned-short) (a10 :int)
(a11 :long-long) (a12 :long) (a13 :short) (a14 :unsigned-int) (a15 :long)
(a16 :unsigned-char) (a17 :int) (a18 :double) (a19 :short) (a20 :short)
(a21 :long-long) (a22 :unsigned-int) (a23 :unsigned-short) (a24 :short)
(a25 :pointer) (a26 :short) (a27 :unsigned-short) (a28 :unsigned-short)
(a29 :int) (a30 :long-long) (a31 :pointer) (a32 :int) (a33 :unsigned-long)
(a34 :unsigned-long) (a35 :pointer) (a36 :unsigned-long-long) (a37 :float)
(a38 :int) (a39 :short) (a40 :pointer) (a41 :unsigned-long-long)
(a42 :long-long) (a43 :unsigned-long) (a44 :unsigned-long)
(a45 :unsigned-long-long) (a46 :unsigned-long) (a47 :char) (a48 :double)
(a49 :long) (a50 :unsigned-int) (a51 :int) (a52 :short) (a53 :pointer)
(a54 :long) (a55 :unsigned-long-long) (a56 :int) (a57 :unsigned-short)
(a58 :unsigned-long-long) (a59 :float) (a60 :pointer) (a61 :float)
(a62 :unsigned-short) (a63 :unsigned-long) (a64 :float) (a65 :unsigned-int)
(a66 :unsigned-long-long) (a67 :pointer) (a68 :double)
(a69 :unsigned-long-long) (a70 :double) (a71 :double) (a72 :long-long)
(a73 :pointer) (a74 :unsigned-short) (a75 :long) (a76 :pointer) (a77 :short)
(a78 :double) (a79 :long) (a80 :unsigned-char) (a81 :pointer)
(a82 :unsigned-char) (a83 :long) (a84 :double) (a85 :pointer) (a86 :int)
(a87 :double) (a88 :unsigned-char) (a89 :double) (a90 :short) (a91 :long)
(a92 :int) (a93 :long) (a94 :double) (a95 :unsigned-short)
(a96 :unsigned-int) (a97 :int) (a98 :char) (a99 :long-long) (a100 :double)
(a101 :float) (a102 :unsigned-long) (a103 :short) (a104 :pointer)
(a105 :float) (a106 :long-long) (a107 :int) (a108 :long-long)
(a109 :long-long) (a110 :double) (a111 :unsigned-long-long) (a112 :double)
(a113 :unsigned-long) (a114 :char) (a115 :char) (a116 :unsigned-long)
(a117 :short) (a118 :unsigned-char) (a119 :unsigned-char) (a120 :int)
(a121 :int) (a122 :float) (a123 :unsigned-char) (a124 :unsigned-char)
(a125 :double) (a126 :unsigned-long-long) (a127 :char))
(deftest defcfun.bff.2
(sum-127
(make-pointer 2746181372) (make-pointer 177623060) -32334.0 3158055028
(make-pointer 242315091) 4288001754991016425 -21047.0d0 287.0d0 18722
243379286 -8677366518541007140 581399424 -13872 4240394881 1353358999
226 969197676 -26207.0d0 6484 11150 1241680089902988480 106068320 61865
2253 (make-pointer 866809333) -31613 35616 11715 1393601698
8940888681199591845 (make-pointer 1524606024) 805638893 3315410736
3432596795 (make-pointer 1490355706) 696175657106383698 -25438.0
1294381547 26724 (make-pointer 3196569545) 2506913373410783697
-4405955718732597856 4075932032 3224670123 2183829215657835866
1318320964 -22 -3786.0d0 -2017024146 1579225515 -626617701 -1456
(make-pointer 3561444187) 395687791 1968033632506257320 -1847773261
48853 142937735275669133 -17974.0 (make-pointer 2791749948) -14140.0
2707 3691328585 3306.0 1132012981 303633191773289330
(make-pointer 981183954) 9114.0d0 8664374572369470 -19013.0d0
-10288.0d0 -3679345119891954339 (make-pointer 3538786709) 23761
-154264605 (make-pointer 2694396308) 7023 997.0d0 1009561368 241
(make-pointer 2612292671) 48 1431872408 -32675.0d0
(make-pointer 1587599336) 958916472 -9857.0d0 111 -14370.0d0 -7308
-967514912 488790941 2146978095 -24111.0d0 13711 86681861 717987770
111 1013402998690933877 17234.0d0 -8772.0 3959216275 -8711
(make-pointer 3142780851) 9480.0 -3820453146461186120 1616574376
-3336232268263990050 -1906114671562979758 -27925.0d0 9695970875869913114
27033.0d0 1096518219 -12 104 3392025403 -27911 60 89 509297051
-533066551 29158.0 110 54 -9802.0d0 593950442165910888 -79)
7758614658402721936))
;;; regression test: defining an undefined foreign function should only
;;; throw some sort of warning, not signal an error.
#+(or cmu (and sbcl (or (not linkage-table) win32)))
(pushnew 'defcfun.undefined rt::*expected-failures*)
(deftest defcfun.undefined
(progn
(eval '(defcfun ("undefined_foreign_function" undefined-foreign-function) :void))
(compile 'undefined-foreign-function)
t)
t)
;;; Test whether all doubles are passed correctly. On some platforms, eg.
;;; darwin/ppc, some are passed on registers others on the stack.
(defcfun "sum_double26" :double
(a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
(a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
(a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
(a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
(a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
(a26 :double))
(deftest defcfun.double26
(sum-double26 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
3.14d0 3.14d0 3.14d0 3.14d0 3.14d0)
81.64d0)
;;; Same as above for floats.
(defcfun "sum_float26" :float
(a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
(a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
(a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
(a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
(a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
(a26 :float))
(deftest defcfun.float26
(sum-float26 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0
5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0)
130.0)