Fix inline fixnum LDB on PowerPC for certain bytespecs

[sbcl.git] / tests / compiler.impure.lisp

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index bf8e74b..a6df1ea 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -16,7 +16,7 @@
 ;;;; more information.
 
 (when (eq sb-ext:*evaluator-mode* :interpret)
-  (sb-ext:quit :unix-status 104))
+  (sb-ext:exit :code 104))
 
 (load "test-util.lisp")
 (load "compiler-test-util.lisp")
@@ -961,38 +961,27 @@
 (defun foo-inline (x) (quux-marker x))
 (declaim (maybe-inline foo-maybe-inline))
 (defun foo-maybe-inline (x) (quux-marker x))
-;; Pretty horrible, but does the job
-(defun count-full-calls (name function)
-  (let ((code (with-output-to-string (s)
-                (disassemble function :stream s)))
-        (n 0))
-    (with-input-from-string (s code)
-      (loop for line = (read-line s nil nil)
-            while line
-            when (search name line)
-            do (incf n)))
-    n))
 
 (with-test (:name :nested-inline-calls)
   (let ((fun (compile nil `(lambda (x)
                              (foo-inline (foo-inline (foo-inline x)))))))
-    (assert (= 0 (count-full-calls "FOO-INLINE" fun)))
-    (assert (= 3 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-INLINE" fun)))
+    (assert (= 3 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :nested-maybe-inline-calls)
   (let ((fun (compile nil `(lambda (x)
                              (declare (optimize (space 0)))
                              (foo-maybe-inline (foo-maybe-inline (foo-maybe-inline x)))))))
-    (assert (= 0 (count-full-calls "FOO-MAYBE-INLINE" fun)))
-    (assert (= 1 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-MAYBE-INLINE" fun)))
+    (assert (= 1 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :inline-calls)
   (let ((fun (compile nil `(lambda (x)
                              (list (foo-inline x)
                                    (foo-inline x)
                                    (foo-inline x))))))
-    (assert (= 0 (count-full-calls "FOO-INLINE" fun)))
-    (assert (= 3 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-INLINE" fun)))
+    (assert (= 3 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :maybe-inline-calls)
   (let ((fun (compile nil `(lambda (x)
@@ -1000,8 +989,8 @@
                              (list (foo-maybe-inline x)
                                    (foo-maybe-inline x)
                                    (foo-maybe-inline x))))))
-    (assert (= 0 (count-full-calls "FOO-MAYBE-INLINE" fun)))
-    (assert (= 1 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-MAYBE-INLINE" fun)))
+    (assert (= 1 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :bug-405)
   ;; These used to break with a TYPE-ERROR
@@ -2275,4 +2264,14 @@
             (assert (= 7 (funcall fun 15 3))))))
     (assert (string= "" trace-output))))
 
+(test-util:with-test (:name :bug-997528)
+  (let ((fun (compile nil '(lambda (x)
+                            (declare (optimize (speed 0) (space 0))
+                             (type (integer -228645653448155482 -228645653447928749) x))
+                            (floor 1.0 (the (integer -228645653448151677 -228645653448150900) x))))))
+    (multiple-value-bind (quo rem)
+        (funcall fun -228645653448151381)
+      (assert (= quo -1))
+      (assert (= rem (float -228645653448151381))))))
+
 ;;; success