X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=130a5af0f735075fa892447cb1ebb698853bc702;hb=3a8bfcb01abe4d8eeb9ef1343d623dbbf57c19d9;hp=3ee09af61c3aab48d9a4414466d56c48f2204504;hpb=5bf4a6a677c80a71dfa31b5c9c374f986594392f;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 3ee09af..130a5af 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -274,3 +274,50 @@
 		(let ((v (make-array 0 :fill-pointer 0)))
 		  (vector-push-extend 1 v)
 		  (copy-seq v))))
+
+;;; to support INLINE functions inside MACROLET, it is necessary for
+;;; FUNCTION-LAMBDA-EXPRESSION to return a proper lambda expression in
+;;; certain circumstances, one of which is when compile is called from
+;;; top-level.
+(assert (equal
+	 (function-lambda-expression
+	  (compile nil '(lambda (x) (block nil (print x)))))
+	 '(lambda (x) (block nil (print x)))))
+
+;;; bug 62: too cautious type inference in a loop
+(assert (nth-value
+         2
+         (compile nil
+                  '(lambda (a)
+                    (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))))