X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Falien.impure.lisp;h=6cd9807452aedb7eac60f88e30eb5d95f32a01b7;hb=0d1d9245c36717a85149dcd01a0ef9e2f0fc56aa;hp=14784ea52af279d3a81f0e08c8d20f265478bf7c;hpb=e29e584efdc110f14698801ad1004f9a34a3b448;p=sbcl.git diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index 14784ea..6cd9807 100644 --- a/tests/alien.impure.lisp +++ b/tests/alien.impure.lisp @@ -68,5 +68,52 @@ (assert (= 1 (slot (slot s1 'x) 'y))) (assert (= 2 (slot (slot s2 'x) 'y)))) +;;; "Alien bug" on sbcl-devel 2004-10-11 by Thomas F. Burdick caused +;;; by recursive struct definition. +(let ((fname "alien-bug-2004-10-11.tmp.lisp")) + (unwind-protect + (progn + (with-open-file (f fname :direction :output) + (mapc (lambda (form) (print form f)) + '((defpackage :alien-bug + (:use :cl :sb-alien)) + (in-package :alien-bug) + (define-alien-type objc-class + (struct objc-class + (protocols + (* (struct protocol-list + (list (array (* (struct objc-class)))))))))))) + (load fname) + (load fname) + (load (compile-file fname)) + (load (compile-file fname))) + (delete-file (compile-file-pathname fname)) + (delete-file fname))) + +;;; enumerations with only one enum resulted in division-by-zero +;;; reported on sbcl-help 2004-11-16 by John Morrison +(define-alien-type enum.1 (enum nil (:val0 0))) + +(define-alien-type enum.2 (enum nil (zero 0) (one 1) (two 2) (three 3) + (four 4) (five 5) (six 6) (seven 7) + (eight 8) (nine 9))) +(with-alien ((integer-array (array integer 3))) + (let ((enum-array (cast integer-array (array enum.2 3)))) + (setf (deref enum-array 0) 'three + (deref enum-array 1) 'four) + (setf (deref integer-array 2) (+ (deref integer-array 0) + (deref integer-array 1))) + (assert (eql (deref enum-array 2) 'seven)))) +;; The code that is used for mapping from integers to symbols depends on the +;; `density' of the set of used integers, so test with a sparse set as well. +(define-alien-type enum.3 (enum nil (zero 0) (one 1) (k-one 1001) (k-two 1002))) +(with-alien ((integer-array (array integer 3))) + (let ((enum-array (cast integer-array (array enum.3 3)))) + (setf (deref enum-array 0) 'one + (deref enum-array 1) 'k-one) + (setf (deref integer-array 2) (+ (deref integer-array 0) + (deref integer-array 1))) + (assert (eql (deref enum-array 2) 'k-two)))) + ;;; success (quit :unix-status 104)