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 (deftest defcfun.varargs.docstrings
160 (documentation 'sprintf
'function
)
163 (deftest defcfun.varargs.char
164 (with-foreign-pointer-as-string (s 100)
165 (sprintf s
"%c" :char
65))
168 (deftest defcfun.varargs.short
169 (with-foreign-pointer-as-string (s 100)
170 (sprintf s
"%d" :short
42))
173 (deftest defcfun.varargs.int
174 (with-foreign-pointer-as-string (s 100)
175 (sprintf s
"%d" :int
1000))
178 (deftest defcfun.varargs.long
179 (with-foreign-pointer-as-string (s 100)
180 (sprintf s
"%ld" :long
131072))
183 (deftest defcfun.varargs.float
184 (with-foreign-pointer-as-string (s 100)
185 (sprintf s
"%.2f" :float
(float pi
)))
188 (deftest defcfun.varargs.double
189 (with-foreign-pointer-as-string (s 100)
190 (sprintf s
"%.2f" :double
(float pi
1.0d0
)))
193 #+(and scl long-float
)
194 (deftest defcfun.varargs.long-double
195 (with-foreign-pointer-as-string (s 100)
196 (setf (mem-ref s
:char
) 0)
197 (sprintf s
"%.2Lf" :long-double pi
))
200 (deftest defcfun.varargs.string
201 (with-foreign-pointer-as-string (s 100)
202 (sprintf s
"%s, %s!" :string
"Hello" :string
"world"))
205 ;;; (let ((rettype (find-type :long))
206 ;;; (arg-types (n-random-types-no-ll 127)))
207 ;;; (c-function rettype arg-types)
208 ;;; (gen-function-test rettype arg-types))
210 #+(:and
(:not
:ecl
) #.
(cl:if
(cl:>= cl
:lambda-parameters-limit
127) '(:and
) '(:or
)))
212 (defcfun "sum_127_no_ll" :long
213 (a1 :long
) (a2 :unsigned-long
) (a3 :short
) (a4 :unsigned-short
) (a5 :float
)
214 (a6 :double
) (a7 :unsigned-long
) (a8 :float
) (a9 :unsigned-char
)
215 (a10 :unsigned-short
) (a11 :short
) (a12 :unsigned-long
) (a13 :double
)
216 (a14 :long
) (a15 :unsigned-int
) (a16 :pointer
) (a17 :unsigned-int
)
217 (a18 :unsigned-short
) (a19 :long
) (a20 :float
) (a21 :pointer
) (a22 :float
)
218 (a23 :int
) (a24 :int
) (a25 :unsigned-short
) (a26 :long
) (a27 :long
)
219 (a28 :double
) (a29 :unsigned-char
) (a30 :unsigned-int
) (a31 :unsigned-int
)
220 (a32 :int
) (a33 :unsigned-short
) (a34 :unsigned-int
) (a35 :pointer
)
221 (a36 :double
) (a37 :double
) (a38 :long
) (a39 :short
) (a40 :unsigned-short
)
222 (a41 :long
) (a42 :char
) (a43 :long
) (a44 :unsigned-short
) (a45 :pointer
)
223 (a46 :int
) (a47 :unsigned-int
) (a48 :double
) (a49 :unsigned-char
)
224 (a50 :unsigned-char
) (a51 :float
) (a52 :int
) (a53 :unsigned-short
)
225 (a54 :double
) (a55 :short
) (a56 :unsigned-char
) (a57 :unsigned-long
)
226 (a58 :float
) (a59 :float
) (a60 :float
) (a61 :pointer
) (a62 :pointer
)
227 (a63 :unsigned-int
) (a64 :unsigned-long
) (a65 :char
) (a66 :short
)
228 (a67 :unsigned-short
) (a68 :unsigned-long
) (a69 :pointer
) (a70 :float
)
229 (a71 :double
) (a72 :long
) (a73 :unsigned-long
) (a74 :short
)
230 (a75 :unsigned-int
) (a76 :unsigned-short
) (a77 :int
) (a78 :unsigned-short
)
231 (a79 :char
) (a80 :double
) (a81 :short
) (a82 :unsigned-char
) (a83 :float
)
232 (a84 :char
) (a85 :int
) (a86 :double
) (a87 :unsigned-char
) (a88 :int
)
233 (a89 :unsigned-long
) (a90 :double
) (a91 :short
) (a92 :short
)
234 (a93 :unsigned-int
) (a94 :unsigned-char
) (a95 :float
) (a96 :long
)
235 (a97 :float
) (a98 :long
) (a99 :long
) (a100 :int
) (a101 :int
)
236 (a102 :unsigned-int
) (a103 :char
) (a104 :char
) (a105 :unsigned-short
)
237 (a106 :unsigned-int
) (a107 :unsigned-short
) (a108 :unsigned-short
)
238 (a109 :int
) (a110 :long
) (a111 :char
) (a112 :double
) (a113 :unsigned-int
)
239 (a114 :char
) (a115 :short
) (a116 :unsigned-long
) (a117 :unsigned-int
)
240 (a118 :short
) (a119 :unsigned-char
) (a120 :float
) (a121 :pointer
)
241 (a122 :double
) (a123 :int
) (a124 :long
) (a125 :char
) (a126 :unsigned-short
)
244 (deftest defcfun.bff
.1
246 1442906394 520035521 -
4715 50335 -
13557.0 -
30892.0d0
24061483 -
23737.0
247 22 2348 4986 104895680 8073.0d0 -
571698147 102484400
248 (make-pointer 507907275) 12733353 7824 -
1275845284 13602.0
249 (make-pointer 286958390) -
8042.0 -
773681663 -
1289932452 31199 -
154985357
250 -
170994216 16845.0d0
177 218969221 2794350893 6068863 26327 127699339
251 (make-pointer 184352771) 18512.0d0 -
12345.0d0 -
179853040 -
19981 37268
252 -
792845398 116 -
1084653028 50494 (make-pointer 2105239646) -
1710519651
253 1557813312 2839.0d0
90 180 30580.0 -
532698978 8623 9537.0d0 -
10882 54
254 184357206 14929.0 -
8190.0 -
25615.0 (make-pointer 235310526)
255 (make-pointer 220476977) 7476055 1576685 -
117 -
11781 31479 23282640
256 (make-pointer 8627281) -
17834.0 10391.0d0 -
1904504370 114393659 -
17062
257 637873619 16078 -
891210259 8107 0 760.0d0 -
21268 104 14133.0 10
258 588598141 310.0d0
20 1351785456 16159552 -
10121.0d0 -
25866 24821
259 68232851 60 -
24132.0 -
1660411658 13387.0 -
786516668 -
499825680
260 -
1128144619 111849719 2746091587 -
2 95 14488 326328135 64781 18204
261 150716680 -
703859275 103 16809.0d0
852235610 -
43 21088 242356110
262 324325428 -
22380 23 24814.0 (make-pointer 40362014) -
14322.0d0
263 -
1864262539 523684371 -
21 49995 -
29175.0)
266 ;;; (let ((rettype (find-type :long-long))
267 ;;; (arg-types (n-random-types 127)))
268 ;;; (c-function rettype arg-types)
269 ;;; (gen-function-test rettype arg-types))
271 #-
(:or
:ecl cffi-features
:no-long-long
272 #.
(cl:if
(cl:>= cl
:lambda-parameters-limit
127) '(:or
) '(:and
)))
274 (defcfun "sum_127" :long-long
275 (a1 :pointer
) (a2 :pointer
) (a3 :float
) (a4 :unsigned-long
) (a5 :pointer
)
276 (a6 :long-long
) (a7 :double
) (a8 :double
) (a9 :unsigned-short
) (a10 :int
)
277 (a11 :long-long
) (a12 :long
) (a13 :short
) (a14 :unsigned-int
) (a15 :long
)
278 (a16 :unsigned-char
) (a17 :int
) (a18 :double
) (a19 :short
) (a20 :short
)
279 (a21 :long-long
) (a22 :unsigned-int
) (a23 :unsigned-short
) (a24 :short
)
280 (a25 :pointer
) (a26 :short
) (a27 :unsigned-short
) (a28 :unsigned-short
)
281 (a29 :int
) (a30 :long-long
) (a31 :pointer
) (a32 :int
) (a33 :unsigned-long
)
282 (a34 :unsigned-long
) (a35 :pointer
) (a36 :unsigned-long-long
) (a37 :float
)
283 (a38 :int
) (a39 :short
) (a40 :pointer
) (a41 :unsigned-long-long
)
284 (a42 :long-long
) (a43 :unsigned-long
) (a44 :unsigned-long
)
285 (a45 :unsigned-long-long
) (a46 :unsigned-long
) (a47 :char
) (a48 :double
)
286 (a49 :long
) (a50 :unsigned-int
) (a51 :int
) (a52 :short
) (a53 :pointer
)
287 (a54 :long
) (a55 :unsigned-long-long
) (a56 :int
) (a57 :unsigned-short
)
288 (a58 :unsigned-long-long
) (a59 :float
) (a60 :pointer
) (a61 :float
)
289 (a62 :unsigned-short
) (a63 :unsigned-long
) (a64 :float
) (a65 :unsigned-int
)
290 (a66 :unsigned-long-long
) (a67 :pointer
) (a68 :double
)
291 (a69 :unsigned-long-long
) (a70 :double
) (a71 :double
) (a72 :long-long
)
292 (a73 :pointer
) (a74 :unsigned-short
) (a75 :long
) (a76 :pointer
) (a77 :short
)
293 (a78 :double
) (a79 :long
) (a80 :unsigned-char
) (a81 :pointer
)
294 (a82 :unsigned-char
) (a83 :long
) (a84 :double
) (a85 :pointer
) (a86 :int
)
295 (a87 :double
) (a88 :unsigned-char
) (a89 :double
) (a90 :short
) (a91 :long
)
296 (a92 :int
) (a93 :long
) (a94 :double
) (a95 :unsigned-short
)
297 (a96 :unsigned-int
) (a97 :int
) (a98 :char
) (a99 :long-long
) (a100 :double
)
298 (a101 :float
) (a102 :unsigned-long
) (a103 :short
) (a104 :pointer
)
299 (a105 :float
) (a106 :long-long
) (a107 :int
) (a108 :long-long
)
300 (a109 :long-long
) (a110 :double
) (a111 :unsigned-long-long
) (a112 :double
)
301 (a113 :unsigned-long
) (a114 :char
) (a115 :char
) (a116 :unsigned-long
)
302 (a117 :short
) (a118 :unsigned-char
) (a119 :unsigned-char
) (a120 :int
)
303 (a121 :int
) (a122 :float
) (a123 :unsigned-char
) (a124 :unsigned-char
)
304 (a125 :double
) (a126 :unsigned-long-long
) (a127 :char
))
306 (deftest defcfun.bff
.2
308 (make-pointer 2746181372) (make-pointer 177623060) -
32334.0 3158055028
309 (make-pointer 242315091) 4288001754991016425 -
21047.0d0
287.0d0
18722
310 243379286 -
8677366518541007140 581399424 -
13872 4240394881 1353358999
311 226 969197676 -
26207.0d0
6484 11150 1241680089902988480 106068320 61865
312 2253 (make-pointer 866809333) -
31613 35616 11715 1393601698
313 8940888681199591845 (make-pointer 1524606024) 805638893 3315410736
314 3432596795 (make-pointer 1490355706) 696175657106383698 -
25438.0
315 1294381547 26724 (make-pointer 3196569545) 2506913373410783697
316 -
4405955718732597856 4075932032 3224670123 2183829215657835866
317 1318320964 -
22 -
3786.0d0 -
2017024146 1579225515 -
626617701 -
1456
318 (make-pointer 3561444187) 395687791 1968033632506257320 -
1847773261
319 48853 142937735275669133 -
17974.0 (make-pointer 2791749948) -
14140.0
320 2707 3691328585 3306.0 1132012981 303633191773289330
321 (make-pointer 981183954) 9114.0d0
8664374572369470 -
19013.0d0
322 -
10288.0d0 -
3679345119891954339 (make-pointer 3538786709) 23761
323 -
154264605 (make-pointer 2694396308) 7023 997.0d0
1009561368 241
324 (make-pointer 2612292671) 48 1431872408 -
32675.0d0
325 (make-pointer 1587599336) 958916472 -
9857.0d0
111 -
14370.0d0 -
7308
326 -
967514912 488790941 2146978095 -
24111.0d0
13711 86681861 717987770
327 111 1013402998690933877 17234.0d0 -
8772.0 3959216275 -
8711
328 (make-pointer 3142780851) 9480.0 -
3820453146461186120 1616574376
329 -
3336232268263990050 -
1906114671562979758 -
27925.0d0
9695970875869913114
330 27033.0d0
1096518219 -
12 104 3392025403 -
27911 60 89 509297051
331 -
533066551 29158.0 110 54 -
9802.0d0
593950442165910888 -
79)
332 7758614658402721936))
334 ;;; regression test: defining an undefined foreign function should only
335 ;;; throw some sort of warning, not signal an error.
337 #+(or cmu
(and sbcl
(or (not linkage-table
) win32
)))
338 (pushnew 'defcfun.undefined rt
::*expected-failures
*)
340 (deftest defcfun.undefined
342 (eval '(defcfun ("undefined_foreign_function" undefined-foreign-function
) :void
))
343 (compile 'undefined-foreign-function
)
347 ;;; Test whether all doubles are passed correctly. On some platforms, eg.
348 ;;; darwin/ppc, some are passed on registers others on the stack.
349 (defcfun "sum_double26" :double
350 (a1 :double
) (a2 :double
) (a3 :double
) (a4 :double
) (a5 :double
)
351 (a6 :double
) (a7 :double
) (a8 :double
) (a9 :double
) (a10 :double
)
352 (a11 :double
) (a12 :double
) (a13 :double
) (a14 :double
) (a15 :double
)
353 (a16 :double
) (a17 :double
) (a18 :double
) (a19 :double
) (a20 :double
)
354 (a21 :double
) (a22 :double
) (a23 :double
) (a24 :double
) (a25 :double
)
357 (deftest defcfun.double26
358 (sum-double26 3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
359 3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
360 3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
361 3.14d0
3.14d0
3.14d0
3.14d0
3.14d0
)
364 ;;; Same as above for floats.
365 (defcfun "sum_float26" :float
366 (a1 :float
) (a2 :float
) (a3 :float
) (a4 :float
) (a5 :float
)
367 (a6 :float
) (a7 :float
) (a8 :float
) (a9 :float
) (a10 :float
)
368 (a11 :float
) (a12 :float
) (a13 :float
) (a14 :float
) (a15 :float
)
369 (a16 :float
) (a17 :float
) (a18 :float
) (a19 :float
) (a20 :float
)
370 (a21 :float
) (a22 :float
) (a23 :float
) (a24 :float
) (a25 :float
)
373 (deftest defcfun.float26
374 (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
375 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)
380 #-cffi-features
:flat-namespace
382 (defcfun ("ns_function" ns-fun1
:library libtest
) :boolean
)
383 (defcfun ("ns_function" ns-fun2
:library libtest2
) :boolean
)
385 (deftest defcfun.namespace
.1
386 (values (ns-fun1) (ns-fun2))
391 #+(and cffi-features
:x86
(not cffi-features
:no-stdcall
))
393 (defcfun ("stdcall_fun@12" stdcall-fun
:cconv
:stdcall
) :int
398 (deftest defcfun.stdcall
.1
399 (loop repeat
100 do
(stdcall-fun 1 2 3)
400 finally
(return (stdcall-fun 1 2 3)))
