;;; failed on Alpha prior to sbcl-0.8.10.30
(defun lotso-values ()
(values 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9
- 0 1 2 3 4 5 6 7 8 9))
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9
+ 0 1 2 3 4 5 6 7 8 9))
;;; bug 313: source transforms were "lisp-1"
(defun srctran-lisp1-1 (cadr) (if (functionp cadr) (funcall cadr 1) nil))
(assert (eql (funcall (eval #'srctran-lisp1-1) #'identity) 1))
-(without-package-locks
+(without-package-locks
;; this be a nasal demon, but test anyways
(defvar caar))
(defun srctran-lisp1-2 (caar) (funcall (sb-ext:truly-the function caar) 1))
(assert (= (isieve 46349) 4792))
+;;; COERCE should not be constant-folded (reported by Nikodemus
+;;; Siivola)
+(let ((f (gensym)))
+ (setf (fdefinition f) (lambda (x) x))
+ (let ((g (compile nil `(lambda () (coerce ',f 'function)))))
+ (setf (fdefinition f) (lambda (x) (1+ x)))
+ (assert (eq (funcall g) (fdefinition f)))))
+
+(let ((x (coerce '(1 11) 'vector)))
+ (incf (aref x 0))
+ (assert (equalp x #(2 11))))
+
+;;; and BIT-* too (reported by Paul F. Dietz)
+(loop with v1 = #*0011
+ and v2 = #*0101
+ for f in '(bit-and bit-andc1 bit-andc2 bit-eqv
+ bit-ior bit-nand bit-nor bit-not
+ bit-orc1 bit-orc2 bit-xor
+ )
+ for form = `(lambda ()
+ (let ((v (,f ,v1 ,v2)))
+ (setf (aref v 0) (- 1 (aref v 0)))
+ (aref v 0)))
+ for compiled-res = (funcall (compile nil form))
+ for real-res = (- 1 (aref (funcall f v1 v2) 0))
+ do (assert (equal compiled-res real-res)))
+(let* ((v #*0011)
+ (form `(lambda ()
+ (let ((v (bit-not ,v)))
+ (setf (aref v 0) (- 1 (aref v 0)))
+ (aref v 0))))
+ (compiled-res (funcall (compile nil form)))
+ (real-res (- 1 (aref (funcall (eval #'bit-not) v) 0))))
+ (assert (equal compiled-res real-res)))
\f
(sb-ext:quit :unix-status 104)