libffi: clean up the ABI enum
[cffi.git] / tests / callbacks.lisp
blob1d3c4595a25acda834fc55b92e3bc8799b99d349
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; callbacks.lisp --- Tests on callbacks.
4 ;;;
5 ;;; Copyright (C) 2005-2006, Luis Oliveira <loliveira(@)common-lisp.net>
6 ;;;
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:
14 ;;;
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
17 ;;;
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.
26 ;;;
28 (in-package #:cffi-tests)
30 (defcfun "expect_char_sum" :int (f :pointer))
31 (defcfun "expect_unsigned_char_sum" :int (f :pointer))
32 (defcfun "expect_short_sum" :int (f :pointer))
33 (defcfun "expect_unsigned_short_sum" :int (f :pointer))
34 (defcfun "expect_int_sum" :int (f :pointer))
35 (defcfun "expect_unsigned_int_sum" :int (f :pointer))
36 (defcfun "expect_long_sum" :int (f :pointer))
37 (defcfun "expect_unsigned_long_sum" :int (f :pointer))
38 (defcfun "expect_float_sum" :int (f :pointer))
39 (defcfun "expect_double_sum" :int (f :pointer))
40 (defcfun "expect_pointer_sum" :int (f :pointer))
41 (defcfun "expect_strcat" :int (f :pointer))
43 #-cffi-sys::no-long-long
44 (progn
45 (defcfun "expect_long_long_sum" :int (f :pointer))
46 (defcfun "expect_unsigned_long_long_sum" :int (f :pointer)))
48 #+(and scl long-float)
49 (defcfun "expect_long_double_sum" :int (f :pointer))
51 (defcallback sum-char :char ((a :char) (b :char))
52 "Test if the named block is present and the docstring too."
53 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
54 (return-from sum-char (+ a b)))
56 (defcallback sum-unsigned-char :unsigned-char
57 ((a :unsigned-char) (b :unsigned-char))
58 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
59 (+ a b))
61 (defcallback sum-short :short ((a :short) (b :short))
62 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
63 (+ a b))
65 (defcallback sum-unsigned-short :unsigned-short
66 ((a :unsigned-short) (b :unsigned-short))
67 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
68 (+ a b))
70 (defcallback sum-int :int ((a :int) (b :int))
71 (+ a b))
73 (defcallback sum-unsigned-int :unsigned-int
74 ((a :unsigned-int) (b :unsigned-int))
75 (+ a b))
77 (defcallback sum-long :long ((a :long) (b :long))
78 (+ a b))
80 (defcallback sum-unsigned-long :unsigned-long
81 ((a :unsigned-long) (b :unsigned-long))
82 (+ a b))
84 #-cffi-sys::no-long-long
85 (progn
86 (defcallback sum-long-long :long-long
87 ((a :long-long) (b :long-long))
88 (+ a b))
90 (defcallback sum-unsigned-long-long :unsigned-long-long
91 ((a :unsigned-long-long) (b :unsigned-long-long))
92 (+ a b)))
94 (defcallback sum-float :float ((a :float) (b :float))
95 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
96 (+ a b))
98 (defcallback sum-double :double ((a :double) (b :double))
99 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
100 (+ a b))
102 #+(and scl long-float)
103 (defcallback sum-long-double :long-double ((a :long-double) (b :long-double))
104 ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
105 (+ a b))
107 (defcallback sum-pointer :pointer ((ptr :pointer) (offset :int))
108 (inc-pointer ptr offset))
110 (defcallback lisp-strcat :string ((a :string) (b :string))
111 (concatenate 'string a b))
113 (deftest callbacks.char
114 (expect-char-sum (get-callback 'sum-char))
117 (deftest callbacks.unsigned-char
118 (expect-unsigned-char-sum (get-callback 'sum-unsigned-char))
121 (deftest callbacks.short
122 (expect-short-sum (callback sum-short))
125 (deftest callbacks.unsigned-short
126 (expect-unsigned-short-sum (callback sum-unsigned-short))
129 (deftest callbacks.int
130 (expect-int-sum (callback sum-int))
133 (deftest callbacks.unsigned-int
134 (expect-unsigned-int-sum (callback sum-unsigned-int))
137 (deftest callbacks.long
138 (expect-long-sum (callback sum-long))
141 (deftest callbacks.unsigned-long
142 (expect-unsigned-long-sum (callback sum-unsigned-long))
145 #-cffi-sys::no-long-long
146 (progn
147 (deftest (callbacks.long-long :expected-to-fail (alexandria:featurep :openmcl))
148 (expect-long-long-sum (callback sum-long-long))
151 (deftest callbacks.unsigned-long-long
152 (expect-unsigned-long-long-sum (callback sum-unsigned-long-long))
155 (deftest callbacks.float
156 (expect-float-sum (callback sum-float))
159 (deftest callbacks.double
160 (expect-double-sum (callback sum-double))
163 #+(and scl long-float)
164 (deftest callbacks.long-double
165 (expect-long-double-sum (callback sum-long-double))
168 (deftest callbacks.pointer
169 (expect-pointer-sum (callback sum-pointer))
172 (deftest callbacks.string
173 (expect-strcat (callback lisp-strcat))
176 #-cffi-sys::no-foreign-funcall
177 (defcallback return-a-string-not-nil :string ()
178 "abc")
180 #-cffi-sys::no-foreign-funcall
181 (deftest callbacks.string-not-docstring
182 (foreign-funcall-pointer (callback return-a-string-not-nil) () :string)
183 "abc")
185 (defcallback check-for-nil :boolean ((pointer :pointer))
186 (null pointer))
188 #-cffi-sys::no-foreign-funcall
189 (deftest callbacks.nil-for-null
190 (foreign-funcall-pointer (callback check-for-nil) nil
191 :pointer (null-pointer) :boolean)
192 nil)
194 ;;; This one tests mem-aref too.
195 (defcfun "qsort" :void
196 (base :pointer)
197 (nmemb :int)
198 (size :int)
199 (fun-compar :pointer))
201 (defcallback < :int ((a :pointer) (b :pointer))
202 (let ((x (mem-ref a :int))
203 (y (mem-ref b :int)))
204 (cond ((> x y) 1)
205 ((< x y) -1)
206 (t 0))))
208 (deftest callbacks.qsort
209 (with-foreign-object (array :int 10)
210 ;; Initialize array.
211 (loop for i from 0 and n in '(7 2 10 4 3 5 1 6 9 8)
212 do (setf (mem-aref array :int i) n))
213 ;; Sort it.
214 (qsort array 10 (foreign-type-size :int) (callback <))
215 ;; Return it as a list.
216 (loop for i from 0 below 10
217 collect (mem-aref array :int i)))
218 (1 2 3 4 5 6 7 8 9 10))
220 ;;; void callback
221 (defparameter *int* -1)
223 (defcfun "pass_int_ref" :void (f :pointer))
225 ;;; CMUCL chokes on this one for some reason.
226 #-(and darwin cmucl)
227 (defcallback read-int-from-pointer :void ((a :pointer))
228 (setq *int* (mem-ref a :int)))
230 #+(and darwin cmucl)
231 (pushnew 'callbacks.void rtest::*expected-failures*)
233 (deftest callbacks.void
234 (progn
235 (pass-int-ref (callback read-int-from-pointer))
236 *int*)
237 1984)
239 ;;; test funcalling of a callback and also declarations inside
240 ;;; callbacks.
242 #-cffi-sys::no-foreign-funcall
243 (progn
244 (defcallback sum-2 :int ((a :int) (b :int) (c :int))
245 (declare (ignore c))
246 (+ a b))
248 (deftest callbacks.funcall.1
249 (foreign-funcall-pointer (callback sum-2) () :int 2 :int 3 :int 1 :int)
252 (defctype foo-float :float)
254 (defcallback sum-2f foo-float
255 ((a foo-float) (b foo-float) (c foo-float) (d foo-float) (e foo-float))
256 "This one ignores the middle 3 arguments."
257 (declare (ignore b c))
258 (declare (ignore d))
259 (+ a e))
261 (deftest callbacks.funcall.2
262 (foreign-funcall-pointer (callback sum-2f) () foo-float 1.0 foo-float 2.0
263 foo-float 3.0 foo-float 4.0 foo-float 5.0
264 foo-float)
265 6.0))
267 ;;; (cb-test :no-long-long t)
269 (defcfun "call_sum_127_no_ll" :long (cb :pointer))
271 ;;; CMUCL and CCL choke on this one.
272 #-(or cmucl clozure
273 #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:or) '(:and)))
274 (defcallback sum-127-no-ll :long
275 ((a1 :unsigned-long) (a2 :pointer) (a3 :long) (a4 :double)
276 (a5 :unsigned-long) (a6 :float) (a7 :float) (a8 :int) (a9 :unsigned-int)
277 (a10 :double) (a11 :double) (a12 :double) (a13 :pointer)
278 (a14 :unsigned-short) (a15 :unsigned-short) (a16 :pointer) (a17 :long)
279 (a18 :long) (a19 :int) (a20 :short) (a21 :unsigned-short)
280 (a22 :unsigned-short) (a23 :char) (a24 :long) (a25 :pointer) (a26 :pointer)
281 (a27 :char) (a28 :unsigned-char) (a29 :unsigned-long) (a30 :short)
282 (a31 :int) (a32 :int) (a33 :unsigned-char) (a34 :short) (a35 :long)
283 (a36 :long) (a37 :pointer) (a38 :unsigned-short) (a39 :char) (a40 :double)
284 (a41 :unsigned-short) (a42 :pointer) (a43 :short) (a44 :unsigned-long)
285 (a45 :unsigned-short) (a46 :float) (a47 :unsigned-char) (a48 :short)
286 (a49 :float) (a50 :short) (a51 :char) (a52 :unsigned-long)
287 (a53 :unsigned-long) (a54 :char) (a55 :float) (a56 :long) (a57 :pointer)
288 (a58 :short) (a59 :float) (a60 :unsigned-int) (a61 :float)
289 (a62 :unsigned-int) (a63 :double) (a64 :unsigned-int) (a65 :unsigned-char)
290 (a66 :int) (a67 :long) (a68 :char) (a69 :short) (a70 :double) (a71 :int)
291 (a72 :pointer) (a73 :char) (a74 :unsigned-short) (a75 :pointer)
292 (a76 :unsigned-short) (a77 :pointer) (a78 :unsigned-long) (a79 :double)
293 (a80 :pointer) (a81 :long) (a82 :float) (a83 :unsigned-short)
294 (a84 :unsigned-short) (a85 :pointer) (a86 :float) (a87 :int)
295 (a88 :unsigned-int) (a89 :double) (a90 :float) (a91 :long) (a92 :pointer)
296 (a93 :unsigned-short) (a94 :float) (a95 :unsigned-char) (a96 :unsigned-char)
297 (a97 :float) (a98 :unsigned-int) (a99 :float) (a100 :unsigned-short)
298 (a101 :double) (a102 :unsigned-short) (a103 :unsigned-long)
299 (a104 :unsigned-int) (a105 :unsigned-long) (a106 :pointer)
300 (a107 :unsigned-char) (a108 :char) (a109 :char) (a110 :unsigned-short)
301 (a111 :unsigned-long) (a112 :float) (a113 :short) (a114 :pointer)
302 (a115 :long) (a116 :unsigned-short) (a117 :short) (a118 :double)
303 (a119 :short) (a120 :int) (a121 :char) (a122 :unsigned-long) (a123 :long)
304 (a124 :int) (a125 :pointer) (a126 :double) (a127 :unsigned-char))
305 (let ((args (list a1 (pointer-address a2) a3 (floor a4) a5 (floor a6)
306 (floor a7) a8 a9 (floor a10) (floor a11) (floor a12)
307 (pointer-address a13) a14 a15 (pointer-address a16) a17 a18
308 a19 a20 a21 a22 a23 a24 (pointer-address a25)
309 (pointer-address a26) a27 a28 a29 a30 a31 a32 a33 a34 a35
310 a36 (pointer-address a37) a38 a39 (floor a40) a41
311 (pointer-address a42) a43 a44 a45 (floor a46) a47 a48
312 (floor a49) a50 a51 a52 a53 a54 (floor a55) a56
313 (pointer-address a57) a58 (floor a59) a60 (floor a61) a62
314 (floor a63) a64 a65 a66 a67 a68 a69 (floor a70) a71
315 (pointer-address a72) a73 a74 (pointer-address a75) a76
316 (pointer-address a77) a78 (floor a79) (pointer-address a80)
317 a81 (floor a82) a83 a84 (pointer-address a85) (floor a86)
318 a87 a88 (floor a89) (floor a90) a91 (pointer-address a92)
319 a93 (floor a94) a95 a96 (floor a97) a98 (floor a99) a100
320 (floor a101) a102 a103 a104 a105 (pointer-address a106) a107
321 a108 a109 a110 a111 (floor a112) a113 (pointer-address a114)
322 a115 a116 a117 (floor a118) a119 a120 a121 a122 a123 a124
323 (pointer-address a125) (floor a126) a127)))
324 #-(and)
325 (loop for i from 1 and arg in args do
326 (format t "a~A: ~A~%" i arg))
327 (reduce #'+ args)))
329 #+(or openmcl cmucl (and darwin (or allegro lispworks)))
330 (push 'callbacks.bff.1 regression-test::*expected-failures*)
332 #+#.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))
333 (deftest callbacks.bff.1
334 (call-sum-127-no-ll (callback sum-127-no-ll))
335 2008547941)
337 ;;; (cb-test)
339 #-(or cffi-sys::no-long-long
340 #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(or) '(and)))
341 (progn
342 (defcfun "call_sum_127" :long-long (cb :pointer))
344 ;;; CMUCL and CCL choke on this one.
345 #-(or cmucl clozure)
346 (defcallback sum-127 :long-long
347 ((a1 :short) (a2 :char) (a3 :pointer) (a4 :float) (a5 :long) (a6 :double)
348 (a7 :unsigned-long-long) (a8 :unsigned-short) (a9 :unsigned-char)
349 (a10 :char) (a11 :char) (a12 :unsigned-short) (a13 :unsigned-long-long)
350 (a14 :unsigned-short) (a15 :long-long) (a16 :unsigned-short)
351 (a17 :unsigned-long-long) (a18 :unsigned-char) (a19 :unsigned-char)
352 (a20 :unsigned-long-long) (a21 :long-long) (a22 :char) (a23 :float)
353 (a24 :unsigned-int) (a25 :float) (a26 :float) (a27 :unsigned-int)
354 (a28 :float) (a29 :char) (a30 :unsigned-char) (a31 :long) (a32 :long-long)
355 (a33 :unsigned-char) (a34 :double) (a35 :long) (a36 :double)
356 (a37 :unsigned-int) (a38 :unsigned-short) (a39 :long-long)
357 (a40 :unsigned-int) (a41 :int) (a42 :unsigned-long-long) (a43 :long)
358 (a44 :short) (a45 :unsigned-int) (a46 :unsigned-int)
359 (a47 :unsigned-long-long) (a48 :unsigned-int) (a49 :long) (a50 :pointer)
360 (a51 :unsigned-char) (a52 :char) (a53 :long-long) (a54 :unsigned-short)
361 (a55 :unsigned-int) (a56 :float) (a57 :unsigned-char) (a58 :unsigned-long)
362 (a59 :long-long) (a60 :float) (a61 :long) (a62 :float) (a63 :int)
363 (a64 :float) (a65 :unsigned-short) (a66 :unsigned-long-long) (a67 :short)
364 (a68 :unsigned-long) (a69 :long) (a70 :char) (a71 :unsigned-short)
365 (a72 :long-long) (a73 :short) (a74 :double) (a75 :pointer)
366 (a76 :unsigned-int) (a77 :char) (a78 :unsigned-int) (a79 :pointer)
367 (a80 :pointer) (a81 :unsigned-char) (a82 :pointer) (a83 :unsigned-short)
368 (a84 :unsigned-char) (a85 :long) (a86 :pointer) (a87 :char) (a88 :long)
369 (a89 :unsigned-short) (a90 :unsigned-char) (a91 :double)
370 (a92 :unsigned-long-long) (a93 :unsigned-short) (a94 :unsigned-short)
371 (a95 :unsigned-int) (a96 :long) (a97 :char) (a98 :long) (a99 :char)
372 (a100 :short) (a101 :unsigned-short) (a102 :unsigned-long)
373 (a103 :unsigned-long) (a104 :short) (a105 :long-long) (a106 :long-long)
374 (a107 :long-long) (a108 :double) (a109 :unsigned-short)
375 (a110 :unsigned-char) (a111 :short) (a112 :unsigned-char) (a113 :long)
376 (a114 :long-long) (a115 :unsigned-long-long) (a116 :unsigned-int)
377 (a117 :unsigned-long) (a118 :unsigned-char) (a119 :long-long)
378 (a120 :unsigned-char) (a121 :unsigned-long-long) (a122 :double)
379 (a123 :unsigned-char) (a124 :long-long) (a125 :unsigned-char)
380 (a126 :char) (a127 :long-long))
381 (+ a1 a2 (pointer-address a3) (values (floor a4)) a5 (values (floor a6))
382 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22
383 (values (floor a23)) a24 (values (floor a25)) (values (floor a26))
384 a27 (values (floor a28)) a29 a30 a31 a32 a33 (values (floor a34))
385 a35 (values (floor a36)) a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47
386 a48 a49 (pointer-address a50) a51 a52 a53 a54 a55 (values (floor a56))
387 a57 a58 a59 (values (floor a60)) a61 (values (floor a62)) a63
388 (values (floor a64)) a65 a66 a67 a68 a69 a70 a71 a72 a73
389 (values (floor a74)) (pointer-address a75) a76 a77 a78
390 (pointer-address a79) (pointer-address a80) a81 (pointer-address a82)
391 a83 a84 a85 (pointer-address a86) a87 a88 a89 a90 (values (floor a91))
392 a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107
393 (values (floor a108)) a109 a110 a111 a112 a113 a114 a115 a116 a117 a118
394 a119 a120 a121 (values (floor a122)) a123 a124 a125 a126 a127))
396 #+(or openmcl cmucl)
397 (push 'callbacks.bff.2 rtest::*expected-failures*)
399 (deftest callbacks.bff.2
400 (call-sum-127 (callback sum-127))
401 8166570665645582011))
403 ;;; regression test: (callback non-existant-callback) should throw an error
404 (deftest callbacks.non-existant
405 (not (null (nth-value 1 (ignore-errors (callback doesnt-exist)))))
408 ;;; Handling many arguments of type double. Many lisps (used to) fail
409 ;;; this one on darwin/ppc. This test might be bogus due to floating
410 ;;; point arithmetic rounding errors.
412 ;;; CMUCL chokes on this one.
413 #-(and darwin cmucl)
414 (defcallback double26 :double
415 ((a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
416 (a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
417 (a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
418 (a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
419 (a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
420 (a26 :double))
421 (let ((args (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15
422 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26)))
423 #-(and)
424 (loop for i from 1 and arg in args do
425 (format t "a~A: ~A~%" i arg))
426 (reduce #'+ args)))
428 (defcfun "call_double26" :double (f :pointer))
430 #+(and darwin (or allegro cmucl))
431 (pushnew 'callbacks.double26 rtest::*expected-failures*)
433 (deftest callbacks.double26
434 (call-double26 (callback double26))
435 81.64d0)
437 #+(and darwin cmucl)
438 (pushnew 'callbacks.double26.funcall rtest::*expected-failures*)
440 #-cffi-sys::no-foreign-funcall
441 (deftest callbacks.double26.funcall
442 (foreign-funcall-pointer
443 (callback double26) () :double 3.14d0 :double 3.14d0
444 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
445 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
446 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
447 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
448 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
449 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
450 :double)
451 81.64d0)
453 ;;; Same as above, for floats.
454 #-(and darwin cmucl)
455 (defcallback float26 :float
456 ((a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
457 (a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
458 (a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
459 (a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
460 (a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
461 (a26 :float))
462 (let ((args (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15
463 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26)))
464 #-(and)
465 (loop for i from 1 and arg in args do
466 (format t "a~A: ~A~%" i arg))
467 (reduce #'+ args)))
469 (defcfun "call_float26" :float (f :pointer))
471 #+(and darwin (or lispworks openmcl cmucl))
472 (pushnew 'callbacks.float26 regression-test::*expected-failures*)
474 (deftest callbacks.float26
475 (call-float26 (callback float26))
476 130.0)
478 #+(and darwin (or lispworks openmcl cmucl))
479 (pushnew 'callbacks.float26.funcall regression-test::*expected-failures*)
481 #-cffi-sys::no-foreign-funcall
482 (deftest callbacks.float26.funcall
483 (foreign-funcall-pointer
484 (callback float26) () :float 5.0 :float 5.0
485 :float 5.0 :float 5.0 :float 5.0 :float 5.0
486 :float 5.0 :float 5.0 :float 5.0 :float 5.0
487 :float 5.0 :float 5.0 :float 5.0 :float 5.0
488 :float 5.0 :float 5.0 :float 5.0 :float 5.0
489 :float 5.0 :float 5.0 :float 5.0 :float 5.0
490 :float 5.0 :float 5.0 :float 5.0 :float 5.0
491 :float)
492 130.0)
494 ;;; Defining a callback as a non-toplevel form. Not portable. Doesn't
495 ;;; work for CMUCL or Allegro.
496 #-(and)
497 (let ((n 42))
498 (defcallback non-toplevel-cb :int ()
501 #-(and)
502 (deftest callbacks.non-toplevel
503 (foreign-funcall (callback non-toplevel-cb) :int)
506 ;;;# Stdcall
508 #+(and x86 (not cffi-sys::no-stdcall))
509 (progn
510 (defcallback (stdcall-cb :convention :stdcall) :int
511 ((a :int) (b :int) (c :int))
512 (+ a b c))
514 (defcfun "call_stdcall_fun" :int
515 (f :pointer))
517 (deftest callbacks.stdcall.1
518 (call-stdcall-fun (callback stdcall-cb))
519 42))
521 ;;; RT: many of the %DEFCALLBACK implementations wouldn't handle
522 ;;; uninterned symbols.
523 (deftest callbacks.uninterned
524 (values (defcallback #1=#:foo :void ())
525 (pointerp (callback #1#)))
526 #1# t)