(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")
m13 m23 m33 m43
m14 m24 m34 m44)))
(declaim (ftype (sb-int:sfunction ((simple-array single-float (3)) single-float) matrix)
- rotate-around-bad))
+ rotate-around))
(defun rotate-around (a radians)
(let ((c (cos radians))
- (s (sin radians))
+ (s (sin radians))
;; The 1.0 here was misloaded on x86-64.
- (g (- 1.0 (cos radians))))
+ (g (- 1.0 (cos radians))))
(let* ((x (aref a 0))
(y (aref a 1))
(z (aref a 2))
(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)))))
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself