X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Falien.impure.lisp;h=4619da3f286a14579a40627476963268105a7c70;hb=1dc3a468ba32755c51747d6e85ed32d989f2dd49;hp=e215ad248069f7f2d56686b27e4a77ce9ea63d1f;hpb=077315581ebab63f28bed96c28fd62626fed42ef;p=sbcl.git diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index e215ad2..4619da3 100644 --- a/tests/alien.impure.lisp +++ b/tests/alien.impure.lisp @@ -136,4 +136,35 @@ v))))) (assert (typep (funcall f "HOME") '(or string null)))) + +;;; CLH: Test for non-standard alignment in alien structs +;;; +(sb-alien:define-alien-type align-test-struct + (sb-alien:union align-test-union + (s (sb-alien:struct nil + (s1 sb-alien:unsigned-char) + (c1 sb-alien:unsigned-char :alignment 16) + (c2 sb-alien:unsigned-char :alignment 32) + (c3 sb-alien:unsigned-char :alignment 32) + (c4 sb-alien:unsigned-char :alignment 8))) + (u (sb-alien:array sb-alien:unsigned-char 16)))) + +(let ((a1 (sb-alien:make-alien align-test-struct))) + (declare (type (sb-alien:alien (* align-test-struct)) a1)) + (setf (sb-alien:slot (sb-alien:slot a1 's) 's1) 1) + (setf (sb-alien:slot (sb-alien:slot a1 's) 'c1) 21) + (setf (sb-alien:slot (sb-alien:slot a1 's) 'c2) 41) + (setf (sb-alien:slot (sb-alien:slot a1 's) 'c3) 61) + (setf (sb-alien:slot (sb-alien:slot a1 's) 'c4) 81) + (assert (equal '(1 21 41 61 81) + (list (sb-alien:deref (sb-alien:slot a1 'u) 0) + (sb-alien:deref (sb-alien:slot a1 'u) 2) + (sb-alien:deref (sb-alien:slot a1 'u) 4) + (sb-alien:deref (sb-alien:slot a1 'u) 8) + (sb-alien:deref (sb-alien:slot a1 'u) 9))))) + +(handler-bind ((compiler-note (lambda (c) + (error "bad note! ~A" c)))) + (funcall (compile nil '(lambda () (sb-alien:make-alien sb-alien:int))))) + ;;; success