0.7.13.11:

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 6080159..130a5af 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -292,3 +292,32 @@
                     (declare (optimize speed (safety 0)))
                     (typecase a
                       (array (loop (print (car a)))))))))
+
+;;; Bug reported by Robert E. Brown sbcl-devel 2003-02-02: compiler
+;;; failure
+(compile nil
+         '(lambda (key tree collect-path-p)
+           (let ((lessp (key-lessp tree))
+                 (equalp (key-equalp tree)))
+             (declare (type (function (t t) boolean) lessp equalp))
+             (let ((path '(nil)))
+               (loop for node = (root-node tree)
+                  then (if (funcall lessp key (node-key node))
+                           (left-child node)
+                           (right-child node))
+                  when (null node)
+                  do (return (values nil nil nil))
+                  do (when collect-path-p
+                       (push node path))
+                  (when (funcall equalp key (node-key node))
+                    (return (values node path t))))))))
+
+;;; CONSTANTLY should return a side-effect-free function (bug caught
+;;; by Paul Dietz' test suite)
+(let ((i 0))
+  (let ((fn (constantly (progn (incf i) 1))))
+    (assert (= i 1))
+    (assert (= (funcall fn) 1))
+    (assert (= i 1))
+    (assert (= (funcall fn) 1))
+    (assert (= i 1))))