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