X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=88463e1333e227c9b846e3be2129d9a5c196d4d8;hb=eb10fa6579d097df831bd4135b418e0c735feb0b;hp=d4608173a4348dc9fd8edb6464217da3858a4340;hpb=d4624e03c64b15a86594b12020da88d7e5167e4f;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index d460817..88463e1 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -774,6 +774,35 @@
                          (declare (type (integer 4303063 101130078) a))
                          (mask-field (byte 18 2) (ash a 77))))
               57132532)))
+;;; rewrite the test case to get the unsigned-byte 32/64
+;;; implementation even after implementing some modular arithmetic
+;;; with signed-byte 30:
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (mask-field (byte 30 2) (ash a 77))))
+              57132532)))
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (mask-field (byte 64 2) (ash a 77))))
+              57132532)))
+;;; and a similar test case for the signed masking extension (not the
+;;; final interface, so change the call when necessary):
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (sb-c::mask-signed-field 30 (ash a 77))))
+              57132532)))
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (sb-c::mask-signed-field 61 (ash a 77))))
+              57132532)))
 
 ;;; MISC.101 and MISC.103: FLUSH-DEST did not mark the USE's block for
 ;;; type check regeneration
@@ -1947,7 +1976,7 @@
                                              (bit #*1001101001001
                                                   (min 12 (max 0 lv3))))))))))))
 
-;;; MISC.624: erronous AVER in x86's %LOGBITP VOPs
+;;; MISC.624: erroneous AVER in x86's %LOGBITP VOPs
 (assert (eql 0
              (funcall
               (compile
@@ -2287,3 +2316,29 @@
                      t)
                    t
                    (error "~a" y)))))
+
+;;; Compiling W-P-O when the pinned objects are known to be fixnums
+;;; or characters.
+(compile nil '(lambda (x y)
+               (declare (fixnum y) (character x))
+               (sb-sys:with-pinned-objects (x y)
+                 (some-random-function))))
+
+;;; *CHECK-CONSISTENCY* and TRULY-THE
+
+(with-test (:name :bug-423)
+  (let ((sb-c::*check-consistency* t))
+    (handler-bind ((warning #'error))
+      (flet ((make-lambda (type)
+               `(lambda (x)
+                  ((lambda (z)
+                     (if (listp z)
+                         (let ((q (truly-the list z)))
+                           (length q))
+                         (if (arrayp z)
+                             (let ((q (truly-the vector z)))
+                               (length q))
+                             (error "oops"))))
+                   (the ,type x)))))
+        (compile nil (make-lambda 'list))
+        (compile nil (make-lambda 'vector))))))