defcfun.lisp - clic - Clic is an command line interactive client for gopher wri… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
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 <[email protected]> | |
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-lo… | |
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 … | |
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 :… | |
351 (a23 :int) (a24 :int) (a25 :unsigned-short) (a26 :long) (a27 :long) | |
352 (a28 :double) (a29 :unsigned-char) (a30 :unsigned-int) (a31 :unsigne… | |
353 (a32 :int) (a33 :unsigned-short) (a34 :unsigned-int) (a35 :pointer) | |
354 (a36 :double) (a37 :double) (a38 :long) (a39 :short) (a40 :unsigned-… | |
355 (a41 :long) (a42 :char) (a43 :long) (a44 :unsigned-short) (a45 :poin… | |
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 :floa… | |
362 (a71 :double) (a72 :long) (a73 :unsigned-long) (a74 :short) | |
363 (a75 :unsigned-int) (a76 :unsigned-short) (a77 :int) (a78 :unsigned-… | |
364 (a79 :char) (a80 :double) (a81 :short) (a82 :unsigned-char) (a83 :fl… | |
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… | |
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… | |
375 (a127 :float)) | |
376 | |
377 (deftest defcfun.bff.1 | |
378 (sum-127-no-ll | |
379 1442906394 520035521 -4715 50335 -13557.0 -30892.0d0 24061483 -23… | |
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 -15… | |
383 -170994216 16845.0d0 177 218969221 2794350893 6068863 26327 12769… | |
384 (make-pointer 184352771) 18512.0d0 -12345.0d0 -179853040 -19981 3… | |
385 -792845398 116 -1084653028 50494 (make-pointer 2105239646) -17105… | |
386 1557813312 2839.0d0 90 180 30580.0 -532698978 8623 9537.0d0 -1088… | |
387 184357206 14929.0 -8190.0 -25615.0 (make-pointer 235310526) | |
388 (make-pointer 220476977) 7476055 1576685 -117 -11781 31479 232826… | |
389 (make-pointer 8627281) -17834.0 10391.0d0 -1904504370 114393659 -… | |
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 :poi… | |
409 (a6 :long-long) (a7 :double) (a8 :double) (a9 :unsigned-short) (a10 … | |
410 (a11 :long-long) (a12 :long) (a13 :short) (a14 :unsigned-int) (a15 :… | |
411 (a16 :unsigned-char) (a17 :int) (a18 :double) (a19 :short) (a20 :sho… | |
412 (a21 :long-long) (a22 :unsigned-int) (a23 :unsigned-short) (a24 :sho… | |
413 (a25 :pointer) (a26 :short) (a27 :unsigned-short) (a28 :unsigned-sho… | |
414 (a29 :int) (a30 :long-long) (a31 :pointer) (a32 :int) (a33 :unsigned… | |
415 (a34 :unsigned-long) (a35 :pointer) (a36 :unsigned-long-long) (a37 :… | |
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 :dou… | |
419 (a49 :long) (a50 :unsigned-int) (a51 :int) (a52 :short) (a53 :pointe… | |
420 (a54 :long) (a55 :unsigned-long-long) (a56 :int) (a57 :unsigned-shor… | |
421 (a58 :unsigned-long-long) (a59 :float) (a60 :pointer) (a61 :float) | |
422 (a62 :unsigned-short) (a63 :unsigned-long) (a64 :float) (a65 :unsign… | |
423 (a66 :unsigned-long-long) (a67 :pointer) (a68 :double) | |
424 (a69 :unsigned-long-long) (a70 :double) (a71 :double) (a72 :long-lon… | |
425 (a73 :pointer) (a74 :unsigned-short) (a75 :long) (a76 :pointer) (a77… | |
426 (a78 :double) (a79 :long) (a80 :unsigned-char) (a81 :pointer) | |
427 (a82 :unsigned-char) (a83 :long) (a84 :double) (a85 :pointer) (a86 :… | |
428 (a87 :double) (a88 :unsigned-char) (a89 :double) (a90 :short) (a91 :… | |
429 (a92 :int) (a93 :long) (a94 :double) (a95 :unsigned-short) | |
430 (a96 :unsigned-int) (a97 :int) (a98 :char) (a99 :long-long) (a100 :d… | |
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 :d… | |
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 31580… | |
444 (make-pointer 242315091) 4288001754991016425 -21047.0d0 287.0d0 1… | |
445 243379286 -8677366518541007140 581399424 -13872 4240394881 135335… | |
446 226 969197676 -26207.0d0 6484 11150 1241680089902988480 106068320… | |
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 -18477732… | |
454 48853 142937735275669133 -17974.0 (make-pointer 2791749948) -1414… | |
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 7179877… | |
462 111 1013402998690933877 17234.0d0 -8772.0 3959216275 -8711 | |
463 (make-pointer 3142780851) 9480.0 -3820453146461186120 1616574376 | |
464 -3336232268263990050 -1906114671562979758 -27925.0d0 969597087586… | |
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-fu… | |
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)) |