(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))))
+
+;;; Bug 240 reported by tonyms on #lisp IRC 2003-02-25 (modified version)
+(loop for (fun warns-p) in
+ '(((lambda (&optional *x*) *x*) t)
+ ((lambda (&optional *x* &rest y) (values *x* y)) t)
+ ((lambda (&optional *print-base*) (values *print-base*)) nil)
+ ((lambda (&optional *print-base* &rest y) (values *print-base* y)) nil)
+ ((lambda (&optional *x*) (declare (special *x*)) (values *x*)) nil)
+ ((lambda (&optional *x* &rest y) (declare (special *x*)) (values *x* y)) nil))
+ for real-warns-p = (nth-value 1 (compile nil fun))
+ do (assert (eq warns-p real-warns-p)))
+
+;;; Bug reported by Gilbert Baumann on #lisp IRC 2003-03-26
+(assert (equal (funcall (eval '(lambda (x &optional (y (pop x))) (list x y)))
+ '(1 2))
+ '((2) 1)))