memory.lisp - clic - Clic is an command line interactive client for gopher writ… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
memory.lisp (19020B) | |
--- | |
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- | |
2 ;;; | |
3 ;;; memory.lisp --- Tests for memory referencing. | |
4 ;;; | |
5 ;;; Copyright (C) 2005-2006, James Bielman <[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 deref.char | |
31 (with-foreign-object (p :char) | |
32 (setf (mem-ref p :char) -127) | |
33 (mem-ref p :char)) | |
34 -127) | |
35 | |
36 (deftest deref.unsigned-char | |
37 (with-foreign-object (p :unsigned-char) | |
38 (setf (mem-ref p :unsigned-char) 255) | |
39 (mem-ref p :unsigned-char)) | |
40 255) | |
41 | |
42 (deftest deref.short | |
43 (with-foreign-object (p :short) | |
44 (setf (mem-ref p :short) -32767) | |
45 (mem-ref p :short)) | |
46 -32767) | |
47 | |
48 (deftest deref.unsigned-short | |
49 (with-foreign-object (p :unsigned-short) | |
50 (setf (mem-ref p :unsigned-short) 65535) | |
51 (mem-ref p :unsigned-short)) | |
52 65535) | |
53 | |
54 (deftest deref.int | |
55 (with-foreign-object (p :int) | |
56 (setf (mem-ref p :int) -131072) | |
57 (mem-ref p :int)) | |
58 -131072) | |
59 | |
60 (deftest deref.unsigned-int | |
61 (with-foreign-object (p :unsigned-int) | |
62 (setf (mem-ref p :unsigned-int) 262144) | |
63 (mem-ref p :unsigned-int)) | |
64 262144) | |
65 | |
66 (deftest deref.long | |
67 (with-foreign-object (p :long) | |
68 (setf (mem-ref p :long) -536870911) | |
69 (mem-ref p :long)) | |
70 -536870911) | |
71 | |
72 (deftest deref.unsigned-long | |
73 (with-foreign-object (p :unsigned-long) | |
74 (setf (mem-ref p :unsigned-long) 536870912) | |
75 (mem-ref p :unsigned-long)) | |
76 536870912) | |
77 | |
78 #+(and darwin openmcl) | |
79 (pushnew 'deref.long-long rt::*expected-failures*) | |
80 | |
81 (deftest deref.long-long | |
82 (with-foreign-object (p :long-long) | |
83 (setf (mem-ref p :long-long) -9223372036854775807) | |
84 (mem-ref p :long-long)) | |
85 -9223372036854775807) | |
86 | |
87 (deftest deref.unsigned-long-long | |
88 (with-foreign-object (p :unsigned-long-long) | |
89 (setf (mem-ref p :unsigned-long-long) 18446744073709551615) | |
90 (mem-ref p :unsigned-long-long)) | |
91 18446744073709551615) | |
92 | |
93 (deftest deref.float.1 | |
94 (with-foreign-object (p :float) | |
95 (setf (mem-ref p :float) 0.0) | |
96 (mem-ref p :float)) | |
97 0.0) | |
98 | |
99 (deftest deref.float.2 | |
100 (with-foreign-object (p :float) | |
101 (setf (mem-ref p :float) *float-max*) | |
102 (mem-ref p :float)) | |
103 #.*float-max*) | |
104 | |
105 (deftest deref.float.3 | |
106 (with-foreign-object (p :float) | |
107 (setf (mem-ref p :float) *float-min*) | |
108 (mem-ref p :float)) | |
109 #.*float-min*) | |
110 | |
111 (deftest deref.double.1 | |
112 (with-foreign-object (p :double) | |
113 (setf (mem-ref p :double) 0.0d0) | |
114 (mem-ref p :double)) | |
115 0.0d0) | |
116 | |
117 (deftest deref.double.2 | |
118 (with-foreign-object (p :double) | |
119 (setf (mem-ref p :double) *double-max*) | |
120 (mem-ref p :double)) | |
121 #.*double-max*) | |
122 | |
123 (deftest deref.double.3 | |
124 (with-foreign-object (p :double) | |
125 (setf (mem-ref p :double) *double-min*) | |
126 (mem-ref p :double)) | |
127 #.*double-min*) | |
128 | |
129 ;;; TODO: use something like *DOUBLE-MIN/MAX* above once we actually | |
130 ;;; have an available lisp that supports long double. | |
131 ;#-cffi-sys::no-long-float | |
132 #+(and scl long-double) | |
133 (progn | |
134 (deftest deref.long-double.1 | |
135 (with-foreign-object (p :long-double) | |
136 (setf (mem-ref p :long-double) 0.0l0) | |
137 (mem-ref p :long-double)) | |
138 0.0l0) | |
139 | |
140 (deftest deref.long-double.2 | |
141 (with-foreign-object (p :long-double) | |
142 (setf (mem-ref p :long-double) most-positive-long-float) | |
143 (mem-ref p :long-double)) | |
144 #.most-positive-long-float) | |
145 | |
146 (deftest deref.long-double.3 | |
147 (with-foreign-object (p :long-double) | |
148 (setf (mem-ref p :long-double) least-positive-long-float) | |
149 (mem-ref p :long-double)) | |
150 #.least-positive-long-float)) | |
151 | |
152 ;;; make sure the lisp doesn't convert NULL to NIL | |
153 (deftest deref.pointer.null | |
154 (with-foreign-object (p :pointer) | |
155 (setf (mem-ref p :pointer) (null-pointer)) | |
156 (null-pointer-p (mem-ref p :pointer))) | |
157 t) | |
158 | |
159 ;;; regression test. lisp-string-to-foreign should handle empty strings | |
160 (deftest lisp-string-to-foreign.empty | |
161 (with-foreign-pointer (str 2) | |
162 (setf (mem-ref str :unsigned-char) 42) | |
163 (lisp-string-to-foreign "" str 1) | |
164 (mem-ref str :unsigned-char)) | |
165 0) | |
166 | |
167 ;;; regression test. with-foreign-pointer shouldn't evaluate | |
168 ;;; the size argument twice. | |
169 (deftest with-foreign-pointer.evalx2 | |
170 (let ((count 0)) | |
171 (with-foreign-pointer (x (incf count) size-var) | |
172 (values count size-var))) | |
173 1 1) | |
174 | |
175 (defconstant +two+ 2) | |
176 | |
177 ;;; regression test. cffi-allegro's with-foreign-pointer wasn't | |
178 ;;; handling constants properly. | |
179 (deftest with-foreign-pointer.constant-size | |
180 (with-foreign-pointer (p +two+ size) | |
181 size) | |
182 2) | |
183 | |
184 (deftest mem-ref.left-to-right | |
185 (let ((i 0)) | |
186 (with-foreign-object (p :char 3) | |
187 (setf (mem-ref p :char 0) 66 (mem-ref p :char 1) 92) | |
188 (setf (mem-ref p :char (incf i)) (incf i)) | |
189 (values (mem-ref p :char 0) (mem-ref p :char 1) i))) | |
190 66 2 2) | |
191 | |
192 ;;; This needs to be in a real function for at least Allegro CL or the | |
193 ;;; compiler macro on %MEM-REF is not expanded and the test doesn't | |
194 ;;; actually test anything! | |
195 (defun %mem-ref-left-to-right () | |
196 (let ((result nil)) | |
197 (with-foreign-object (p :char) | |
198 (%mem-set 42 p :char) | |
199 (%mem-ref (progn (push 1 result) p) :char (progn (push 2 result) 0… | |
200 (nreverse result)))) | |
201 | |
202 ;;; Test left-to-right evaluation of the arguments to %MEM-REF when | |
203 ;;; optimized by the compiler macro. | |
204 (deftest %mem-ref.left-to-right | |
205 (%mem-ref-left-to-right) | |
206 (1 2)) | |
207 | |
208 ;;; This needs to be in a top-level function for at least Allegro CL | |
209 ;;; or the compiler macro on %MEM-SET is not expanded and the test | |
210 ;;; doesn't actually test anything! | |
211 (defun %mem-set-left-to-right () | |
212 (let ((result nil)) | |
213 (with-foreign-object (p :char) | |
214 (%mem-set (progn (push 1 result) 0) | |
215 (progn (push 2 result) p) | |
216 :char | |
217 (progn (push 3 result) 0)) | |
218 (nreverse result)))) | |
219 | |
220 ;;; Test left-to-right evaluation of the arguments to %MEM-SET when | |
221 ;;; optimized by the compiler macro. | |
222 (deftest %mem-set.left-to-right | |
223 (%mem-set-left-to-right) | |
224 (1 2 3)) | |
225 | |
226 ;; regression test. mem-aref's setf expansion evaluated its type argumen… | |
227 (deftest mem-aref.eval-type-x2 | |
228 (let ((count 0)) | |
229 (with-foreign-pointer (p 1) | |
230 (setf (mem-aref p (progn (incf count) :char) 0) 127)) | |
231 count) | |
232 1) | |
233 | |
234 (deftest mem-aref.left-to-right | |
235 (let ((count -1)) | |
236 (with-foreign-pointer (p 2) | |
237 (values | |
238 (setf (mem-aref p (progn (incf count) :char) (incf count)) (inc… | |
239 (setq count -1) | |
240 (mem-aref (progn (incf count) p) :char (incf count)) | |
241 count))) | |
242 2 -1 2 1) | |
243 | |
244 ;; regression tests. nested mem-ref's and mem-aref's had bogus getters | |
245 (deftest mem-ref.nested | |
246 (with-foreign-object (p :pointer) | |
247 (with-foreign-object (i :int) | |
248 (setf (mem-ref p :pointer) i) | |
249 (setf (mem-ref i :int) 42) | |
250 (setf (mem-ref (mem-ref p :pointer) :int) 1984) | |
251 (mem-ref i :int))) | |
252 1984) | |
253 | |
254 (deftest mem-aref.nested | |
255 (with-foreign-object (p :pointer) | |
256 (with-foreign-object (i :int 2) | |
257 (setf (mem-aref p :pointer 0) i) | |
258 (setf (mem-aref i :int 1) 42) | |
259 (setf (mem-aref (mem-ref p :pointer 0) :int 1) 1984) | |
260 (mem-aref i :int 1))) | |
261 1984) | |
262 | |
263 (cffi:defcstruct mem-aref.bare-struct | |
264 (a :uint8)) | |
265 | |
266 ;;; regression test: although mem-aref was dealing with bare struct | |
267 ;;; types as though they were pointers, it wasn't calculating the | |
268 ;;; proper offsets. The offsets for bare structs types should be | |
269 ;;; calculated as aggregate types. | |
270 (deftest mem-aref.bare-struct | |
271 (with-foreign-object (a 'mem-aref.bare-struct 2) | |
272 (eql (- (pointer-address (cffi:mem-aref a 'mem-aref.bare-struct 1)) | |
273 (pointer-address (cffi:mem-aref a 'mem-aref.bare-struct 0)… | |
274 (foreign-type-size '(:struct mem-aref.bare-struct)))) | |
275 t) | |
276 | |
277 ;;; regression tests. dereferencing an aggregate type. dereferencing a | |
278 ;;; struct should return a pointer to the struct itself, not return the | |
279 ;;; first 4 bytes (or whatever the size of :pointer is) as a pointer. | |
280 ;;; | |
281 ;;; This important for accessing an array of structs, which is | |
282 ;;; what the deref.array-of-aggregates test does. | |
283 (defcstruct some-struct (x :int)) | |
284 | |
285 (deftest deref.aggregate | |
286 (with-foreign-object (s 'some-struct) | |
287 (pointer-eq s (mem-ref s 'some-struct))) | |
288 t) | |
289 | |
290 (deftest deref.array-of-aggregates | |
291 (with-foreign-object (arr 'some-struct 3) | |
292 (loop for i below 3 | |
293 do (setf (foreign-slot-value (mem-aref arr 'some-struct i) | |
294 'some-struct 'x) | |
295 112)) | |
296 (loop for i below 3 | |
297 collect (foreign-slot-value (mem-aref arr 'some-struct i) | |
298 'some-struct 'x))) | |
299 (112 112 112)) | |
300 | |
301 ;;; pointer operations | |
302 (deftest pointer.1 | |
303 (pointer-address (make-pointer 42)) | |
304 42) | |
305 | |
306 ;;; I suppose this test is not very good. --luis | |
307 (deftest pointer.2 | |
308 (pointer-address (null-pointer)) | |
309 0) | |
310 | |
311 (deftest pointer.null | |
312 (nth-value 0 (ignore-errors (null-pointer-p nil))) | |
313 nil) | |
314 | |
315 (deftest foreign-pointer-type.nil | |
316 (typep nil 'foreign-pointer) | |
317 nil) | |
318 | |
319 ;;; Ensure that a pointer to the highest possible address can be | |
320 ;;; created using MAKE-POINTER. Regression test for CLISP/X86-64. | |
321 (deftest make-pointer.high | |
322 (let* ((pointer-length (foreign-type-size :pointer)) | |
323 (high-address (1- (expt 2 (* pointer-length 8)))) | |
324 (pointer (make-pointer high-address))) | |
325 (- high-address (pointer-address pointer))) | |
326 0) | |
327 | |
328 ;;; Ensure that incrementing a pointer by zero bytes returns an | |
329 ;;; equivalent pointer. | |
330 (deftest inc-pointer.zero | |
331 (with-foreign-object (x :int) | |
332 (pointer-eq x (inc-pointer x 0))) | |
333 t) | |
334 | |
335 ;;; Test the INITIAL-ELEMENT keyword argument to FOREIGN-ALLOC. | |
336 (deftest foreign-alloc.1 | |
337 (let ((ptr (foreign-alloc :int :initial-element 42))) | |
338 (unwind-protect | |
339 (mem-ref ptr :int) | |
340 (foreign-free ptr))) | |
341 42) | |
342 | |
343 ;;; Test the INITIAL-ELEMENT and COUNT arguments to FOREIGN-ALLOC. | |
344 (deftest foreign-alloc.2 | |
345 (let ((ptr (foreign-alloc :int :count 4 :initial-element 100))) | |
346 (unwind-protect | |
347 (loop for i from 0 below 4 | |
348 collect (mem-aref ptr :int i)) | |
349 (foreign-free ptr))) | |
350 (100 100 100 100)) | |
351 | |
352 ;;; Test the INITIAL-CONTENTS and COUNT arguments to FOREIGN-ALLOC, | |
353 ;;; passing a list of initial values. | |
354 (deftest foreign-alloc.3 | |
355 (let ((ptr (foreign-alloc :int :count 4 :initial-contents '(4 3 2 1)… | |
356 (unwind-protect | |
357 (loop for i from 0 below 4 | |
358 collect (mem-aref ptr :int i)) | |
359 (foreign-free ptr))) | |
360 (4 3 2 1)) | |
361 | |
362 ;;; Test INITIAL-CONTENTS and COUNT with FOREIGN-ALLOC passing a | |
363 ;;; vector of initial values. | |
364 (deftest foreign-alloc.4 | |
365 (let ((ptr (foreign-alloc :int :count 4 :initial-contents #(10 20 30… | |
366 (unwind-protect | |
367 (loop for i from 0 below 4 | |
368 collect (mem-aref ptr :int i)) | |
369 (foreign-free ptr))) | |
370 (10 20 30 40)) | |
371 | |
372 ;;; Ensure calling FOREIGN-ALLOC with both INITIAL-ELEMENT and | |
373 ;;; INITIAL-CONTENTS signals an error. | |
374 (deftest foreign-alloc.5 | |
375 (values | |
376 (ignore-errors | |
377 (let ((ptr (foreign-alloc :int :initial-element 1 | |
378 :initial-contents '(1)))) | |
379 (foreign-free ptr)) | |
380 t)) | |
381 nil) | |
382 | |
383 ;;; Regression test: FOREIGN-ALLOC shouldn't actually perform translation | |
384 ;;; on initial-element/initial-contents since MEM-AREF will do that alre… | |
385 (define-foreign-type not-an-int () | |
386 () | |
387 (:actual-type :int) | |
388 (:simple-parser not-an-int)) | |
389 | |
390 (defmethod translate-to-foreign (value (type not-an-int)) | |
391 (assert (not (integerp value))) | |
392 0) | |
393 | |
394 (deftest foreign-alloc.6 | |
395 (let ((ptr (foreign-alloc 'not-an-int :initial-element 'foooo))) | |
396 (foreign-free ptr) | |
397 t) | |
398 t) | |
399 | |
400 ;;; Ensure calling FOREIGN-ALLOC with NULL-TERMINATED-P and a non-pointer | |
401 ;;; type signals an error. | |
402 (deftest foreign-alloc.7 | |
403 (values | |
404 (ignore-errors | |
405 (let ((ptr (foreign-alloc :int :null-terminated-p t))) | |
406 (foreign-free ptr)) | |
407 t)) | |
408 nil) | |
409 | |
410 ;;; The opposite of the above test. | |
411 (defctype pointer-alias :pointer) | |
412 | |
413 (deftest foreign-alloc.8 | |
414 (progn | |
415 (foreign-free (foreign-alloc 'pointer-alias :count 0 :null-termina… | |
416 t) | |
417 t) | |
418 | |
419 ;;; Ensure calling FOREIGN-ALLOC with NULL-TERMINATED-P actually places | |
420 ;;; a null pointer at the end. Not a very reliable test apparently. | |
421 (deftest foreign-alloc.9 | |
422 (let ((ptr (foreign-alloc :pointer :count 0 :null-terminated-p t))) | |
423 (unwind-protect | |
424 (null-pointer-p (mem-ref ptr :pointer)) | |
425 (foreign-free ptr))) | |
426 t) | |
427 | |
428 ;;; RT: FOREIGN-ALLOC with :COUNT 0 on CLISP signalled an error. | |
429 (deftest foreign-alloc.10 | |
430 (null (foreign-free (foreign-alloc :char :count 0))) | |
431 t) | |
432 | |
433 ;;; Tests for mem-ref with a non-constant type. This is a way to test | |
434 ;;; the functional interface (without compiler macros). | |
435 | |
436 (deftest deref.nonconst.char | |
437 (let ((type :char)) | |
438 (with-foreign-object (p type) | |
439 (setf (mem-ref p type) -127) | |
440 (mem-ref p type))) | |
441 -127) | |
442 | |
443 (deftest deref.nonconst.unsigned-char | |
444 (let ((type :unsigned-char)) | |
445 (with-foreign-object (p type) | |
446 (setf (mem-ref p type) 255) | |
447 (mem-ref p type))) | |
448 255) | |
449 | |
450 (deftest deref.nonconst.short | |
451 (let ((type :short)) | |
452 (with-foreign-object (p type) | |
453 (setf (mem-ref p type) -32767) | |
454 (mem-ref p type))) | |
455 -32767) | |
456 | |
457 (deftest deref.nonconst.unsigned-short | |
458 (let ((type :unsigned-short)) | |
459 (with-foreign-object (p type) | |
460 (setf (mem-ref p type) 65535) | |
461 (mem-ref p type))) | |
462 65535) | |
463 | |
464 (deftest deref.nonconst.int | |
465 (let ((type :int)) | |
466 (with-foreign-object (p type) | |
467 (setf (mem-ref p type) -131072) | |
468 (mem-ref p type))) | |
469 -131072) | |
470 | |
471 (deftest deref.nonconst.unsigned-int | |
472 (let ((type :unsigned-int)) | |
473 (with-foreign-object (p type) | |
474 (setf (mem-ref p type) 262144) | |
475 (mem-ref p type))) | |
476 262144) | |
477 | |
478 (deftest deref.nonconst.long | |
479 (let ((type :long)) | |
480 (with-foreign-object (p type) | |
481 (setf (mem-ref p type) -536870911) | |
482 (mem-ref p type))) | |
483 -536870911) | |
484 | |
485 (deftest deref.nonconst.unsigned-long | |
486 (let ((type :unsigned-long)) | |
487 (with-foreign-object (p type) | |
488 (setf (mem-ref p type) 536870912) | |
489 (mem-ref p type))) | |
490 536870912) | |
491 | |
492 #+(and darwin openmcl) | |
493 (pushnew 'deref.nonconst.long-long rt::*expected-failures*) | |
494 | |
495 (deftest deref.nonconst.long-long | |
496 (let ((type :long-long)) | |
497 (with-foreign-object (p type) | |
498 (setf (mem-ref p type) -9223372036854775807) | |
499 (mem-ref p type))) | |
500 -9223372036854775807) | |
501 | |
502 (deftest deref.nonconst.unsigned-long-long | |
503 (let ((type :unsigned-long-long)) | |
504 (with-foreign-object (p type) | |
505 (setf (mem-ref p type) 18446744073709551615) | |
506 (mem-ref p type))) | |
507 18446744073709551615) | |
508 | |
509 (deftest deref.nonconst.float.1 | |
510 (let ((type :float)) | |
511 (with-foreign-object (p type) | |
512 (setf (mem-ref p type) 0.0) | |
513 (mem-ref p type))) | |
514 0.0) | |
515 | |
516 (deftest deref.nonconst.float.2 | |
517 (let ((type :float)) | |
518 (with-foreign-object (p type) | |
519 (setf (mem-ref p type) *float-max*) | |
520 (mem-ref p type))) | |
521 #.*float-max*) | |
522 | |
523 (deftest deref.nonconst.float.3 | |
524 (let ((type :float)) | |
525 (with-foreign-object (p type) | |
526 (setf (mem-ref p type) *float-min*) | |
527 (mem-ref p type))) | |
528 #.*float-min*) | |
529 | |
530 (deftest deref.nonconst.double.1 | |
531 (let ((type :double)) | |
532 (with-foreign-object (p type) | |
533 (setf (mem-ref p type) 0.0d0) | |
534 (mem-ref p type))) | |
535 0.0d0) | |
536 | |
537 (deftest deref.nonconst.double.2 | |
538 (let ((type :double)) | |
539 (with-foreign-object (p type) | |
540 (setf (mem-ref p type) *double-max*) | |
541 (mem-ref p type))) | |
542 #.*double-max*) | |
543 | |
544 (deftest deref.nonconst.double.3 | |
545 (let ((type :double)) | |
546 (with-foreign-object (p type) | |
547 (setf (mem-ref p type) *double-min*) | |
548 (mem-ref p type))) | |
549 #.*double-min*) | |
550 | |
551 ;;; regression tests: lispworks's %mem-ref and %mem-set compiler | |
552 ;;; macros were misbehaving. | |
553 | |
554 (defun mem-ref-rt-1 () | |
555 (with-foreign-object (a :int 2) | |
556 (setf (mem-aref a :int 0) 123 | |
557 (mem-aref a :int 1) 456) | |
558 (values (mem-aref a :int 0) (mem-aref a :int 1)))) | |
559 | |
560 (deftest mem-ref.rt.1 | |
561 (mem-ref-rt-1) | |
562 123 456) | |
563 | |
564 (defun mem-ref-rt-2 () | |
565 (with-foreign-object (a :double 2) | |
566 (setf (mem-aref a :double 0) 123.0d0 | |
567 (mem-aref a :double 1) 456.0d0) | |
568 (values (mem-aref a :double 0) (mem-aref a :double 1)))) | |
569 | |
570 (deftest mem-ref.rt.2 | |
571 (mem-ref-rt-2) | |
572 123.0d0 456.0d0) | |
573 | |
574 (deftest incf-pointer.1 | |
575 (let ((ptr (null-pointer))) | |
576 (incf-pointer ptr) | |
577 (pointer-address ptr)) | |
578 1) | |
579 | |
580 (deftest incf-pointer.2 | |
581 (let ((ptr (null-pointer))) | |
582 (incf-pointer ptr 42) | |
583 (pointer-address ptr)) | |
584 42) | |
585 | |
586 (deftest pointerp.1 | |
587 (values | |
588 (pointerp (null-pointer)) | |
589 (null-pointer-p (null-pointer)) | |
590 (typep (null-pointer) 'foreign-pointer)) | |
591 t t t) | |
592 | |
593 (deftest pointerp.2 | |
594 (let ((p (make-pointer #xFEFF))) | |
595 (values | |
596 (pointerp p) | |
597 (typep p 'foreign-pointer))) | |
598 t t) | |
599 | |
600 (deftest pointerp.3 | |
601 (pointerp 'not-a-pointer) | |
602 nil) | |
603 | |
604 (deftest pointerp.4 | |
605 (pointerp 42) | |
606 nil) | |
607 | |
608 (deftest pointerp.5 | |
609 (pointerp 0) | |
610 nil) | |
611 | |
612 (deftest pointerp.6 | |
613 (pointerp nil) | |
614 nil) | |
615 | |
616 (deftest mem-ref.setf.1 | |
617 (with-foreign-object (p :char) | |
618 (setf (mem-ref p :char) 42)) | |
619 42) | |
620 | |
621 (define-foreign-type int+1 () | |
622 () | |
623 (:actual-type :int) | |
624 (:simple-parser int+1)) | |
625 | |
626 (defmethod translate-to-foreign (value (type int+1)) | |
627 (1+ value)) | |
628 | |
629 (defmethod translate-from-foreign (value (type int+1)) | |
630 (1+ value)) | |
631 | |
632 (deftest mem-ref.setf.2 | |
633 (with-foreign-object (p 'int+1) | |
634 (values (setf (mem-ref p 'int+1) 42) | |
635 (mem-ref p 'int+1))) | |
636 42 ; should this be 43? | |
637 44) | |
638 | |
639 (deftest pointer-eq.non-pointers.1 | |
640 (expecting-error (pointer-eq 1 2)) | |
641 :error) | |
642 | |
643 (deftest pointer-eq.non-pointers.2 | |
644 (expecting-error (pointer-eq 'a 'b)) | |
645 :error) | |
646 | |
647 (deftest null-pointer-p.non-pointer.1 | |
648 (expecting-error (null-pointer-p 'not-a-pointer)) | |
649 :error) | |
650 | |
651 (deftest null-pointer-p.non-pointer.2 | |
652 (expecting-error (null-pointer-p 0)) | |
653 :error) | |
654 | |
655 (deftest null-pointer-p.non-pointer.3 | |
656 (expecting-error (null-pointer-p nil)) | |
657 :error) |