Tweak to work with SunOS /bin/sh.

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 51068be..b8643a1 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3600,7 +3600,7 @@
   ;; Test that compile-times don't explode when quoted constants
   ;; get big.
   (labels ((time-n (n)
-             (gc :full t) ; Let's not confuse the issue with GC            
+             (gc :full t) ; Let's not confuse the issue with GC
              (let* ((tree (make-tree (expt 10 n) nil))
                     (t0 (get-internal-run-time))
                     (f (compile nil `(lambda (x) (eq x (quote ,tree)))))
@@ -3859,3 +3859,36 @@
                        (delete x y :test #'eql))))
     (assert (equal (list #'sb-int:delq)
                    (ctu:find-named-callees fun)))))
+
+(with-test (:name :bug-767959)
+  ;; This used to signal an error.
+  (compile nil `(lambda ()
+                  (declare (optimize sb-c:store-coverage-data))
+                  (assoc
+                   nil
+                   '((:ordinary . ordinary-lambda-list))))))
+
+(with-test (:name :member-on-long-constant-list)
+  ;; This used to blow stack with a sufficiently long list.
+  (let ((cycle (list t)))
+    (nconc cycle cycle)
+    (compile nil `(lambda (x)
+                    (member x ',cycle)))))
+
+(with-test (:name :bug-722734)
+  (assert (raises-error?
+            (funcall (compile
+                      nil
+                      '(lambda ()
+                        (eql (make-array 6)
+                         (list unbound-variable-1 unbound-variable-2))))))))
+
+(with-test (:name :bug-771673)
+  (assert (equal `(the foo bar) (macroexpand `(truly-the foo bar))))
+  ;; Make sure the compiler doesn't use THE, and check that setf-expansions
+  ;; work.
+  (let ((f (compile nil `(lambda (x y)
+                           (setf (truly-the fixnum (car x)) y)))))
+    (let* ((cell (cons t t)))
+      (funcall f cell :ok)
+      (assert (equal '(:ok . t) cell)))))