X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=f410d4db31a50d88e51b0fbe2af8b2d53c63a5cb;hb=371577a214ce2659c271279ad48e4c42e1c0c93e;hp=f24c436b101d45871834c794c9d7f815a29593dc;hpb=d0376c0b2e38ff518c85d50a5befd3a13e14d3e1;p=sbcl.git diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index f24c436..f410d4d 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -19,6 +19,7 @@ (sb-ext:quit :unix-status 104)) (load "test-util.lisp") +(load "compiler-test-util.lisp") (load "assertoid.lisp") (use-package "TEST-UTIL") (use-package "ASSERTOID") @@ -1145,6 +1146,26 @@ (make-array 3 :element-type 'single-float) (coerce pi 'single-float)))) ;; Same bug manifests in COMPLEX-ATANH as well. (assert (= (atanh #C(-0.7d0 1.1d0)) #C(-0.28715567731069275d0 0.9394245539093365d0)))) + +(with-test (:name :slot-value-on-structure) + (let ((f (compile nil `(lambda (x a b) + (declare (something-known-to-be-a-struct x)) + (setf (slot-value x 'x) a + (slot-value x 'y) b) + (list (slot-value x 'x) + (slot-value x 'y)))))) + (assert (equal '(#\x #\y) + (funcall f + (make-something-known-to-be-a-struct :x "X" :y "Y") + #\x #\y))) + (assert (not (ctu:find-named-callees f))))) + +(defclass some-slot-thing () + ((slot :initarg :slot))) +(with-test (:name :with-slots-the) + (let ((x (make-instance 'some-slot-thing :slot "foo"))) + (with-slots (slot) (the some-slot-thing x) + (assert (equal "foo" slot))))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself