X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fcompiler.pure.lisp;h=9376ba164b6126af1728d2c8dda9aa25415f19d3;hb=732ad8030a354ff38af83a84173bfc919a4d7f1c;hp=c58eb9ede764da5ccb50c864159dbb22e62b6835;hpb=dc47746daf73c65126a80b723ad52b8327b06960;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index c58eb9e..9376ba1 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1723,15 +1723,16 @@
       (error "bad RANDOM event"))))
 
 ;;; 0.8.17.28-sma.1 lost derived type information.
-(handler-bind ((sb-ext:compiler-note #'error))
-  (compile nil
-    '(lambda (x y v)
-      (declare (optimize (speed 3) (safety 0)))
-      (declare (type (integer 0 80) x)
-       (type (integer 0 11) y)
-       (type (simple-array (unsigned-byte 32) (*)) v))
-      (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
-      nil)))
+(with-test (:name "0.8.17.28-sma.1" :fails-on :sparc)
+  (handler-bind ((sb-ext:compiler-note (lambda (c) (error "~A" c))))
+    (compile nil
+      '(lambda (x y v)
+        (declare (optimize (speed 3) (safety 0)))
+        (declare (type (integer 0 80) x)
+         (type (integer 0 11) y)
+         (type (simple-array (unsigned-byte 32) (*)) v))
+        (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
+        nil))))
 
 ;;; Bug reported by Robert J. Macomber: instrumenting of more-entry
 ;;; prevented open coding of %LISTIFY-REST-ARGS.
@@ -1888,3 +1889,29 @@
 ;;; sbcl-devel)
 (compile nil '(lambda (x y a b c)
                (- y (* (signum x) (sqrt (abs (- (* b x) c)))))))
+
+;;; Type inference from CHECK-TYPE
+(let ((count0 0) (count1 0))
+  (handler-bind ((sb-ext:compiler-note (lambda (c) (incf count0))))
+    (compile nil '(lambda (x)
+                   (declare (optimize (speed 3)))
+                   (1+ x))))
+  ;; forced-to-do GENERIC-+, etc
+  (assert (> count0 0))
+  (handler-bind ((sb-ext:compiler-note (lambda (c) (incf count1))))
+    (compile nil '(lambda (x)
+                   (declare (optimize (speed 3)))
+                   (check-type x fixnum)
+                   (1+ x))))
+  (assert (= count1 0)))
+
+;;; Up to 0.9.8.22 x86-64 had broken return value handling in the
+;;; %SET-SAP-REF-DOUBLE/SINGLE VOPs.
+(with-test (:name :sap-ref-float)
+  (compile nil '(lambda (sap)
+                 (let ((x (setf (sb-vm::sap-ref-double sap 0) 1d0)))
+                   (1+ x))))
+  (compile nil '(lambda (sap)
+                 (let ((x (setf (sb-vm::sap-ref-single sap 0) 1d0)))
+                   (1+ x)))))
+