defcfun.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
defcfun.lisp (19900B)
---
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; defcfun.lisp --- Tests function definition and calling.
4 ;;;
5 ;;; Copyright (C) 2005-2007, 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 ;;;
27
28 (in-package #:cffi-tests)
29
30 (deftest defcfun.parse-name-and-options.1
31 (multiple-value-bind (lisp-name foreign-name)
32 (let ((*package* (find-package '#:cffi-tests)))
33 (cffi::parse-name-and-options "foo_bar"))
34 (list lisp-name foreign-name))
35 (foo-bar "foo_bar"))
36
37 (deftest defcfun.parse-name-and-options.2
38 (multiple-value-bind (lisp-name foreign-name)
39 (let ((*package* (find-package '#:cffi-tests)))
40 (cffi::parse-name-and-options "foo_bar" t))
41 (list lisp-name foreign-name))
42 (*foo-bar* "foo_bar"))
43
44 (deftest defcfun.parse-name-and-options.3
45 (multiple-value-bind (lisp-name foreign-name)
46 (cffi::parse-name-and-options 'foo-bar)
47 (list lisp-name foreign-name))
48 (foo-bar "foo_bar"))
49
50 (deftest defcfun.parse-name-and-options.4
51 (multiple-value-bind (lisp-name foreign-name)
52 (cffi::parse-name-and-options '*foo-bar* t)
53 (list lisp-name foreign-name))
54 (*foo-bar* "foo_bar"))
55
56 (deftest defcfun.parse-name-and-options.5
57 (multiple-value-bind (lisp-name foreign-name)
58 (cffi::parse-name-and-options '("foo_bar" foo-baz))
59 (list lisp-name foreign-name))
60 (foo-baz "foo_bar"))
61
62 (deftest defcfun.parse-name-and-options.6
63 (multiple-value-bind (lisp-name foreign-name)
64 (cffi::parse-name-and-options '("foo_bar" *foo-baz*) t)
65 (list lisp-name foreign-name))
66 (*foo-baz* "foo_bar"))
67
68 (deftest defcfun.parse-name-and-options.7
69 (multiple-value-bind (lisp-name foreign-name)
70 (cffi::parse-name-and-options '(foo-baz "foo_bar"))
71 (list lisp-name foreign-name))
72 (foo-baz "foo_bar"))
73
74 (deftest defcfun.parse-name-and-options.8
75 (multiple-value-bind (lisp-name foreign-name)
76 (cffi::parse-name-and-options '(*foo-baz* "foo_bar") t)
77 (list lisp-name foreign-name))
78 (*foo-baz* "foo_bar"))
79
80 ;;;# Name translation
81
82 (deftest translate-underscore-separated-name.to-symbol
83 (let ((*package* (find-package '#:cffi-tests)))
84 (translate-underscore-separated-name "some_name_with_underscores"))
85 some-name-with-underscores)
86
87 (deftest translate-underscore-separated-name.to-string
88 (translate-underscore-separated-name 'some-name-with-underscores)
89 "some_name_with_underscores")
90
91 (deftest translate-camelcase-name.to-symbol
92 (let ((*package* (find-package '#:cffi-tests)))
93 (translate-camelcase-name "someXmlFunction"))
94 some-xml-function)
95
96 (deftest translate-camelcase-name.to-string
97 (translate-camelcase-name 'some-xml-function)
98 "someXmlFunction")
99
100 (deftest translate-camelcase-name.to-string-upper
101 (translate-camelcase-name 'some-xml-function :upper-initial-p t)
102 "SomeXmlFunction")
103
104 (deftest translate-camelcase-name.to-symbol-special
105 (let ((*package* (find-package '#:cffi-tests)))
106 (translate-camelcase-name "someXMLFunction" :special-words '("XML")))
107 some-xml-function)
108
109 (deftest translate-camelcase-name.to-string-special
110 (translate-camelcase-name 'some-xml-function :special-words '("XML"))
111 "someXMLFunction")
112
113 (deftest translate-name-from-foreign.function
114 (let ((*package* (find-package '#:cffi-tests)))
115 (translate-name-from-foreign "some_xml_name" *package*))
116 some-xml-name)
117
118 (deftest translate-name-from-foreign.var
119 (let ((*package* (find-package '#:cffi-tests)))
120 (translate-name-from-foreign "some_xml_name" *package* t))
121 *some-xml-name*)
122
123 (deftest translate-name-to-foreign.function
124 (translate-name-to-foreign 'some-xml-name *package*)
125 "some_xml_name")
126
127 (deftest translate-name-to-foreign.var
128 (translate-name-to-foreign '*some-xml-name* *package* t)
129 "some_xml_name")
130
131 ;;;# Calling with built-in c types
132 ;;;
133 ;;; Tests calling standard C library functions both passing
134 ;;; and returning each built-in type. (adapted from funcall.lisp)
135
136 (defcfun "toupper" :char
137 "toupper docstring"
138 (char :char))
139
140 (deftest defcfun.char
141 (toupper (char-code #\a))
142 #.(char-code #\A))
143
144 (deftest defcfun.docstring
145 (documentation 'toupper 'function)
146 "toupper docstring")
147
148
149 (defcfun ("abs" c-abs) :int
150 (n :int))
151
152 (deftest defcfun.int
153 (c-abs -100)
154 100)
155
156
157 (defcfun "labs" :long
158 (n :long))
159
160 (deftest defcfun.long
161 (labs -131072)
162 131072)
163
164
165 #-cffi-features:no-long-long
166 (progn
167 (defcfun "my_llabs" :long-long
168 (n :long-long))
169
170 (deftest defcfun.long-long
171 (my-llabs -9223372036854775807)
172 9223372036854775807)
173
174 (defcfun "ullong" :unsigned-long-long
175 (n :unsigned-long-long))
176
177 #+allegro ; lp#914500
178 (pushnew 'defcfun.unsigned-long-long rt::*expected-failures*)
179
180 (deftest defcfun.unsigned-long-long
181 (let ((ullong-max (1- (expt 2 (* 8 (foreign-type-size :unsigned-long-long))))))
182 (eql ullong-max (ullong ullong-max)))
183 t))
184
185
186 (defcfun "my_sqrtf" :float
187 (n :float))
188
189 (deftest defcfun.float
190 (my-sqrtf 16.0)
191 4.0)
192
193
194 (defcfun ("sqrt" c-sqrt) :double
195 (n :double))
196
197 (deftest defcfun.double
198 (c-sqrt 36.0d0)
199 6.0d0)
200
201
202 #+(and scl long-float)
203 (defcfun ("sqrtl" c-sqrtl) :long-double
204 (n :long-double))
205
206 #+(and scl long-float)
207 (deftest defcfun.long-double
208 (c-sqrtl 36.0l0)
209 6.0l0)
210
211
212 (defcfun "strlen" :int
213 (n :string))
214
215 (deftest defcfun.string.1
216 (strlen "Hello")
217 5)
218
219
220 (defcfun "strcpy" (:pointer :char)
221 (dest (:pointer :char))
222 (src :string))
223
224 (defcfun "strcat" (:pointer :char)
225 (dest (:pointer :char))
226 (src :string))
227
228 (deftest defcfun.string.2
229 (with-foreign-pointer-as-string (s 100)
230 (setf (mem-ref s :char) 0)
231 (strcpy s "Hello")
232 (strcat s ", world!"))
233 "Hello, world!")
234
235 (defcfun "strerror" :string
236 (n :int))
237
238 (deftest defcfun.string.3
239 (typep (strerror 1) 'string)
240 t)
241
242
243 ;;; Regression test. Allegro would warn on direct calls to
244 ;;; functions with no arguments.
245 ;;;
246 ;;; Also, let's check if void functions will return NIL.
247 ;;;
248 ;;; Check if a docstring without arguments doesn't cause problems.
249
250 (defcfun "noargs" :int
251 "docstring")
252
253 (deftest defcfun.noargs
254 (noargs)
255 42)
256
257 (defcfun "noop" :void)
258
259 #+(or allegro openmcl ecl) (pushnew 'defcfun.noop rt::*expected-failures*)
260
261 (deftest defcfun.noop
262 (noop)
263 #|no values|#)
264
265 ;;;# Calling varargs functions
266
267 (defcfun "sum_double_arbitrary" :double (n :int) &rest)
268
269 (deftest defcfun.varargs.nostdlib
270 (sum-double-arbitrary
271 26
272 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
273 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
274 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
275 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
276 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
277 :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
278 :double 3.14d0 :double 3.14d0)
279 81.64d0)
280
281 (defcfun "sprintf" :int
282 "sprintf docstring"
283 (str (:pointer :char))
284 (control :string)
285 &rest)
286
287 ;;; CLISP and ABCL discard macro docstrings.
288 #+(or clisp abcl)
289 (pushnew 'defcfun.varargs.docstrings rt::*expected-failures*)
290
291 (deftest defcfun.varargs.docstrings
292 (documentation 'sprintf 'function)
293 "sprintf docstring")
294
295 (deftest defcfun.varargs.char
296 (with-foreign-pointer-as-string (s 100)
297 (sprintf s "%c" :char 65))
298 "A")
299
300 (deftest defcfun.varargs.short
301 (with-foreign-pointer-as-string (s 100)
302 (sprintf s "%d" :short 42))
303 "42")
304
305 (deftest defcfun.varargs.int
306 (with-foreign-pointer-as-string (s 100)
307 (sprintf s "%d" :int 1000))
308 "1000")
309
310 (deftest defcfun.varargs.long
311 (with-foreign-pointer-as-string (s 100)
312 (sprintf s "%ld" :long 131072))
313 "131072")
314
315 (deftest defcfun.varargs.float
316 (with-foreign-pointer-as-string (s 100)
317 (sprintf s "%.2f" :float (float pi)))
318 "3.14")
319
320 (deftest defcfun.varargs.double
321 (with-foreign-pointer-as-string (s 100)
322 (sprintf s "%.2f" :double (float pi 1.0d0)))
323 "3.14")
324
325 #+(and scl long-float)
326 (deftest defcfun.varargs.long-double
327 (with-foreign-pointer-as-string (s 100)
328 (setf (mem-ref s :char) 0)
329 (sprintf s "%.2Lf" :long-double pi))
330 "3.14")
331
332 (deftest defcfun.varargs.string
333 (with-foreign-pointer-as-string (s 100)
334 (sprintf s "%s, %s!" :string "Hello" :string "world"))
335 "Hello, world!")
336
337 ;;; (let ((rettype (find-type :long))
338 ;;; (arg-types (n-random-types-no-ll 127)))
339 ;;; (c-function rettype arg-types)
340 ;;; (gen-function-test rettype arg-types))
341
342 #+(and (not ecl)
343 #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or)))
344 (progn
345 (defcfun "sum_127_no_ll" :long
346 (a1 :long) (a2 :unsigned-long) (a3 :short) (a4 :unsigned-short) (a5 :float)
347 (a6 :double) (a7 :unsigned-long) (a8 :float) (a9 :unsigned-char)
348 (a10 :unsigned-short) (a11 :short) (a12 :unsigned-long) (a13 :double)
349 (a14 :long) (a15 :unsigned-int) (a16 :pointer) (a17 :unsigned-int)
350 (a18 :unsigned-short) (a19 :long) (a20 :float) (a21 :pointer) (a22 :float)
351 (a23 :int) (a24 :int) (a25 :unsigned-short) (a26 :long) (a27 :long)
352 (a28 :double) (a29 :unsigned-char) (a30 :unsigned-int) (a31 :unsigned-int)
353 (a32 :int) (a33 :unsigned-short) (a34 :unsigned-int) (a35 :pointer)
354 (a36 :double) (a37 :double) (a38 :long) (a39 :short) (a40 :unsigned-short)
355 (a41 :long) (a42 :char) (a43 :long) (a44 :unsigned-short) (a45 :pointer)
356 (a46 :int) (a47 :unsigned-int) (a48 :double) (a49 :unsigned-char)
357 (a50 :unsigned-char) (a51 :float) (a52 :int) (a53 :unsigned-short)
358 (a54 :double) (a55 :short) (a56 :unsigned-char) (a57 :unsigned-long)
359 (a58 :float) (a59 :float) (a60 :float) (a61 :pointer) (a62 :pointer)
360 (a63 :unsigned-int) (a64 :unsigned-long) (a65 :char) (a66 :short)
361 (a67 :unsigned-short) (a68 :unsigned-long) (a69 :pointer) (a70 :float)
362 (a71 :double) (a72 :long) (a73 :unsigned-long) (a74 :short)
363 (a75 :unsigned-int) (a76 :unsigned-short) (a77 :int) (a78 :unsigned-short)
364 (a79 :char) (a80 :double) (a81 :short) (a82 :unsigned-char) (a83 :float)
365 (a84 :char) (a85 :int) (a86 :double) (a87 :unsigned-char) (a88 :int)
366 (a89 :unsigned-long) (a90 :double) (a91 :short) (a92 :short)
367 (a93 :unsigned-int) (a94 :unsigned-char) (a95 :float) (a96 :long)
368 (a97 :float) (a98 :long) (a99 :long) (a100 :int) (a101 :int)
369 (a102 :unsigned-int) (a103 :char) (a104 :char) (a105 :unsigned-short)
370 (a106 :unsigned-int) (a107 :unsigned-short) (a108 :unsigned-short)
371 (a109 :int) (a110 :long) (a111 :char) (a112 :double) (a113 :unsigned-int)
372 (a114 :char) (a115 :short) (a116 :unsigned-long) (a117 :unsigned-int)
373 (a118 :short) (a119 :unsigned-char) (a120 :float) (a121 :pointer)
374 (a122 :double) (a123 :int) (a124 :long) (a125 :char) (a126 :unsigned-short)
375 (a127 :float))
376
377 (deftest defcfun.bff.1
378 (sum-127-no-ll
379 1442906394 520035521 -4715 50335 -13557.0 -30892.0d0 24061483 -23737.0
380 22 2348 4986 104895680 8073.0d0 -571698147 102484400
381 (make-pointer 507907275) 12733353 7824 -1275845284 13602.0
382 (make-pointer 286958390) -8042.0 -773681663 -1289932452 31199 -154985357
383 -170994216 16845.0d0 177 218969221 2794350893 6068863 26327 127699339
384 (make-pointer 184352771) 18512.0d0 -12345.0d0 -179853040 -19981 37268
385 -792845398 116 -1084653028 50494 (make-pointer 2105239646) -1710519651
386 1557813312 2839.0d0 90 180 30580.0 -532698978 8623 9537.0d0 -10882 54
387 184357206 14929.0 -8190.0 -25615.0 (make-pointer 235310526)
388 (make-pointer 220476977) 7476055 1576685 -117 -11781 31479 23282640
389 (make-pointer 8627281) -17834.0 10391.0d0 -1904504370 114393659 -17062
390 637873619 16078 -891210259 8107 0 760.0d0 -21268 104 14133.0 10
391 588598141 310.0d0 20 1351785456 16159552 -10121.0d0 -25866 24821
392 68232851 60 -24132.0 -1660411658 13387.0 -786516668 -499825680
393 -1128144619 111849719 2746091587 -2 95 14488 326328135 64781 18204
394 150716680 -703859275 103 16809.0d0 852235610 -43 21088 242356110
395 324325428 -22380 23 24814.0 (make-pointer 40362014) -14322.0d0
396 -1864262539 523684371 -21 49995 -29175.0)
397 796447501))
398
399 ;;; (let ((rettype (find-type :long-long))
400 ;;; (arg-types (n-random-types 127)))
401 ;;; (c-function rettype arg-types)
402 ;;; (gen-function-test rettype arg-types))
403
404 #-(or ecl cffi-sys::no-long-long
405 #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:or) '(:and)))
406 (progn
407 (defcfun "sum_127" :long-long
408 (a1 :pointer) (a2 :pointer) (a3 :float) (a4 :unsigned-long) (a5 :pointer)
409 (a6 :long-long) (a7 :double) (a8 :double) (a9 :unsigned-short) (a10 :int)
410 (a11 :long-long) (a12 :long) (a13 :short) (a14 :unsigned-int) (a15 :long)
411 (a16 :unsigned-char) (a17 :int) (a18 :double) (a19 :short) (a20 :short)
412 (a21 :long-long) (a22 :unsigned-int) (a23 :unsigned-short) (a24 :short)
413 (a25 :pointer) (a26 :short) (a27 :unsigned-short) (a28 :unsigned-short)
414 (a29 :int) (a30 :long-long) (a31 :pointer) (a32 :int) (a33 :unsigned-long)
415 (a34 :unsigned-long) (a35 :pointer) (a36 :unsigned-long-long) (a37 :float)
416 (a38 :int) (a39 :short) (a40 :pointer) (a41 :unsigned-long-long)
417 (a42 :long-long) (a43 :unsigned-long) (a44 :unsigned-long)
418 (a45 :unsigned-long-long) (a46 :unsigned-long) (a47 :char) (a48 :double)
419 (a49 :long) (a50 :unsigned-int) (a51 :int) (a52 :short) (a53 :pointer)
420 (a54 :long) (a55 :unsigned-long-long) (a56 :int) (a57 :unsigned-short)
421 (a58 :unsigned-long-long) (a59 :float) (a60 :pointer) (a61 :float)
422 (a62 :unsigned-short) (a63 :unsigned-long) (a64 :float) (a65 :unsigned-int)
423 (a66 :unsigned-long-long) (a67 :pointer) (a68 :double)
424 (a69 :unsigned-long-long) (a70 :double) (a71 :double) (a72 :long-long)
425 (a73 :pointer) (a74 :unsigned-short) (a75 :long) (a76 :pointer) (a77 :short)
426 (a78 :double) (a79 :long) (a80 :unsigned-char) (a81 :pointer)
427 (a82 :unsigned-char) (a83 :long) (a84 :double) (a85 :pointer) (a86 :int)
428 (a87 :double) (a88 :unsigned-char) (a89 :double) (a90 :short) (a91 :long)
429 (a92 :int) (a93 :long) (a94 :double) (a95 :unsigned-short)
430 (a96 :unsigned-int) (a97 :int) (a98 :char) (a99 :long-long) (a100 :double)
431 (a101 :float) (a102 :unsigned-long) (a103 :short) (a104 :pointer)
432 (a105 :float) (a106 :long-long) (a107 :int) (a108 :long-long)
433 (a109 :long-long) (a110 :double) (a111 :unsigned-long-long) (a112 :double)
434 (a113 :unsigned-long) (a114 :char) (a115 :char) (a116 :unsigned-long)
435 (a117 :short) (a118 :unsigned-char) (a119 :unsigned-char) (a120 :int)
436 (a121 :int) (a122 :float) (a123 :unsigned-char) (a124 :unsigned-char)
437 (a125 :double) (a126 :unsigned-long-long) (a127 :char))
438
439 #+(and sbcl x86) (push 'defcfun.bff.2 rtest::*expected-failures*)
440
441 (deftest defcfun.bff.2
442 (sum-127
443 (make-pointer 2746181372) (make-pointer 177623060) -32334.0 3158055028
444 (make-pointer 242315091) 4288001754991016425 -21047.0d0 287.0d0 18722
445 243379286 -8677366518541007140 581399424 -13872 4240394881 1353358999
446 226 969197676 -26207.0d0 6484 11150 1241680089902988480 106068320 61865
447 2253 (make-pointer 866809333) -31613 35616 11715 1393601698
448 8940888681199591845 (make-pointer 1524606024) 805638893 3315410736
449 3432596795 (make-pointer 1490355706) 696175657106383698 -25438.0
450 1294381547 26724 (make-pointer 3196569545) 2506913373410783697
451 -4405955718732597856 4075932032 3224670123 2183829215657835866
452 1318320964 -22 -3786.0d0 -2017024146 1579225515 -626617701 -1456
453 (make-pointer 3561444187) 395687791 1968033632506257320 -1847773261
454 48853 142937735275669133 -17974.0 (make-pointer 2791749948) -14140.0
455 2707 3691328585 3306.0 1132012981 303633191773289330
456 (make-pointer 981183954) 9114.0d0 8664374572369470 -19013.0d0
457 -10288.0d0 -3679345119891954339 (make-pointer 3538786709) 23761
458 -154264605 (make-pointer 2694396308) 7023 997.0d0 1009561368 241
459 (make-pointer 2612292671) 48 1431872408 -32675.0d0
460 (make-pointer 1587599336) 958916472 -9857.0d0 111 -14370.0d0 -7308
461 -967514912 488790941 2146978095 -24111.0d0 13711 86681861 717987770
462 111 1013402998690933877 17234.0d0 -8772.0 3959216275 -8711
463 (make-pointer 3142780851) 9480.0 -3820453146461186120 1616574376
464 -3336232268263990050 -1906114671562979758 -27925.0d0 9695970875869913114
465 27033.0d0 1096518219 -12 104 3392025403 -27911 60 89 509297051
466 -533066551 29158.0 110 54 -9802.0d0 593950442165910888 -79)
467 7758614658402721936))
468
469 ;;; regression test: defining an undefined foreign function should only
470 ;;; throw some sort of warning, not signal an error.
471
472 #+(or cmucl (and sbcl win32))
473 (pushnew 'defcfun.undefined rt::*expected-failures*)
474
475 (deftest defcfun.undefined
476 (progn
477 (eval '(defcfun ("undefined_foreign_function" undefined-foreign-function) :void))
478 (compile 'undefined-foreign-function)
479 t)
480 t)
481
482 ;;; Test whether all doubles are passed correctly. On some platforms, eg.
483 ;;; darwin/ppc, some are passed on registers others on the stack.
484 (defcfun "sum_double26" :double
485 (a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
486 (a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
487 (a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
488 (a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
489 (a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
490 (a26 :double))
491
492 (deftest defcfun.double26
493 (sum-double26 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
494 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
495 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
496 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0)
497 81.64d0)
498
499 ;;; Same as above for floats.
500 (defcfun "sum_float26" :float
501 (a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
502 (a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
503 (a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
504 (a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
505 (a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
506 (a26 :float))
507
508 (deftest defcfun.float26
509 (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
510 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)
511 130.0)
512
513 ;;;# Namespaces
514
515 #-cffi-sys::flat-namespace
516 (progn
517 (defcfun ("ns_function" ns-fun1 :library libtest) :boolean)
518 (defcfun ("ns_function" ns-fun2 :library libtest2) :boolean)
519
520 (deftest defcfun.namespace.1
521 (values (ns-fun1) (ns-fun2))
522 t nil))
523
524 ;;;# stdcall
525
526 #+(and x86 windows (not cffi-sys::no-stdcall))
527 (progn
528 (defcfun ("stdcall_fun@12" stdcall-fun :convention :stdcall) :int
529 (a :int)
530 (b :int)
531 (c :int))
532
533 (deftest defcfun.stdcall.1
534 (loop repeat 100 do (stdcall-fun 1 2 3)
535 finally (return (stdcall-fun 1 2 3)))
536 6))