;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
-;;;;
+;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
;;; 0 is not of type (OR FUNCTION SB-KERNEL:FDEFN).
;;; Correct behavior is to warn at compile time because the symbol
;;; isn't declared as a variable, but to set its SYMBOL-VALUE anyway.
-;;;
+;;;
;;; This bug was in sbcl-0.6.11.13.
(print (setq improperly-declared-var '(1 2)))
(assert (equal (symbol-value 'improperly-declared-var) '(1 2)))
(assert (equal (foo '(1 2 #\a 3)) '((1) (2))))
(assert (equal (foo '(1 2 x 3)) 'x)))
+;;; compiler failure found by Paul Dietz' randomized tortuter
+(defun #:foo (a b c d)
+ (declare (type (integer 240 100434465) a)
+ (optimize (speed 3) (safety 1) (debug 1)))
+ (logxor
+ (if (ldb-test (byte 27 4) d)
+ -1
+ (max 55546856 -431))
+ (logorc2
+ (if (>= 0 b)
+ (if (> b c) (logandc2 c d) (if (> d 224002) 0 d))
+ (signum (logior c b)))
+ (logior a -1))))
+
+(defun #:foo (b c)
+ (declare (type (integer -23228343 2) b)
+ (type (integer -115581022 512244512) c)
+ (optimize (speed 3) (safety 1) (debug 1)))
+ (* (* (logorc2 3 (deposit-field 4667947 (byte 14 26) b))
+ (deposit-field b (byte 25 27) -30424886))
+ (dpb b (byte 23 29) c)))
+
+(defun #:foo (x y)
+ (declare (type (integer -1 1000000000000000000000000) x y)
+ (optimize speed))
+ (* x (* y x)))
+
+(defun #:foo (b)
+ (declare (type (integer -290488443 2) b)
+ (optimize (speed 3) (safety 1) (debug 1)))
+ (let ((v3 (min -1720 b))) (max v3 (logcount (if (= v3 b) b b)))))
+
+(defun #:foo (d)
+ (let ((v7 (flet ((%f16 () (labels ((%f3 () -8)) (%f3))))
+ (labels ((%f7 () (%f16))) d))))
+ 132887443))
+
+;;; RESULT-FORM in DO is not contained in the implicit TAGBODY
+(assert (eq (handler-case (eval `(do ((x '(1 2 3) (cdr x)))
+ ((endp x) (go :loop))
+ :loop
+ (unless x (return :bad))))
+ (error () :good))
+ :good))
+(assert (eq (handler-case (eval `(do* ((x '(1 2 3) (cdr x)))
+ ((endp x) (go :loop))
+ :loop
+ (unless x (return :bad))))
+ (error () :good))
+ :good))
+
;;; bug 282
;;;
;;; Verify type checking policy in full calls: the callee is supposed
;;; to perform check, but the results should not be used before the
;;; check will be actually performed.
-#+nil
(locally
(declare (optimize (safety 3)))
(flet ((bar (f a)
(declare (type (simple-array (unsigned-byte 32) (*)) a))
(declare (type (function (fixnum)) f))
(funcall f (aref a 0))))
+ #-x86-64
(assert
(eval `(let ((n (1+ most-positive-fixnum)))
(if (not (typep n '(unsigned-byte 32)))
(make-array 1 :element-type '(unsigned-byte 32)
:initial-element n))
nil)))))))
+
+;;; bug 261
+(let ((x (list (the (values &optional fixnum) (eval '(values))))))
+ (assert (equal x '(nil))))
+
+;;; Bug 125, reported by Gabe Garza: Python did not preserve identity
+;;; of closures.
+(flet ((test-case (test-pred x)
+ (let ((func (lambda () x)))
+ (list (eq func func)
+ (funcall test-pred func func)
+ (delete func (list func))))))
+ (assert (equal '(t t nil) (funcall (eval #'test-case) #'eq 3))))
+
+;;; compiler failure reported by Alan Shields:
+;;; MAYBE-INFER-ITERATION-VAR-TYPE did not deal with types (REAL * (n)).
+(let ((s (loop for x from (- pi) below (floor (* 2 pi)) by (/ pi 75) count t)))
+ (assert (= s 219)))
+
+(with-test (:name :specialized-array-dumping)
+ (macrolet
+ ((make-tests ()
+ `(progn
+ ,@(loop for saetp across
+ sb-vm:*specialized-array-element-type-properties*
+ for specifier = (sb-vm:saetp-specifier saetp)
+ for array = (make-array (if specifier 10 0)
+ :element-type specifier)
+ for make-array = `(make-array ,(if specifier 10 0)
+ :element-type ',specifier)
+ collect `(assert (and (equal (type-of ,array)
+ ',(type-of array))
+ (equalp ,array
+ ,make-array)))))))
+ (make-tests)))
projects / sbcl.git / blobdiff