X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure-cload.lisp;h=3a20ebdf46b0d0e152db92d2c95e9b8ccf586342;hb=9c9d6dbdc28a8bfe70be09f35263e9ec02411d0e;hp=9fe19519fdfa61c0ba34d81f00adc10f702a2deb;hpb=94cc1963322581d9e4b6bbd96c399a0507c601be;p=sbcl.git

diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index 9fe1951..3a20ebd 100644
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -6,7 +6,7 @@
 ;;;; 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.
@@ -27,7 +27,7 @@
 ;;;     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)))
@@ -83,18 +83,55 @@
         (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)))
@@ -107,3 +144,38 @@
                              (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)))