X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=7cced511149fb541a34f9abf80df0e61bc4e210d;hb=f7808fb1c49b729d00580321b3f8457ce4b84cf4;hp=f50322ee32cc462b6194f2494b03648d789554db;hpb=f32ee7df37cdc62596e849c079f365000424a712;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index f50322e..7cced51 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4411,3 +4411,68 @@ do (assert (equal (car (cdaddr (sb-kernel:%simple-fun-type (compile nil function)))) result-type))))) + +(with-test (:name :bug-504121) + (compile nil `(lambda (s) + (let ((p1 #'upper-case-p)) + (funcall + (lambda (g) + (funcall p1 g)))) + (let ((p2 #'(lambda (char) (upper-case-p char)))) + (funcall p2 s))))) + +(with-test (:name (:bug-504121 :optional-missing)) + (compile nil `(lambda (s) + (let ((p1 #'upper-case-p)) + (funcall + (lambda (g &optional x) + (funcall p1 g)))) + (let ((p2 #'(lambda (char) (upper-case-p char)))) + (funcall p2 s))))) + +(with-test (:name (:bug-504121 :optional-superfluous)) + (compile nil `(lambda (s) + (let ((p1 #'upper-case-p)) + (funcall + (lambda (g &optional x) + (funcall p1 g)) + #\1 2 3)) + (let ((p2 #'(lambda (char) (upper-case-p char)))) + (funcall p2 s))))) + +(with-test (:name (:bug-504121 :key-odd)) + (compile nil `(lambda (s) + (let ((p1 #'upper-case-p)) + (funcall + (lambda (g &key x) + (funcall p1 g)) + #\1 :x)) + (let ((p2 #'(lambda (char) (upper-case-p char)))) + (funcall p2 s))))) + +(with-test (:name (:bug-504121 :key-unknown)) + (compile nil `(lambda (s) + (let ((p1 #'upper-case-p)) + (funcall + (lambda (g &key x) + (funcall p1 g)) + #\1 :y 2)) + (let ((p2 #'(lambda (char) (upper-case-p char)))) + (funcall p2 s))))) + +(with-test (:name :bug-1181684) + (compile nil `(lambda () + (let ((hash #xD13CCD13)) + (setf hash (logand most-positive-word + (ash hash 5))))))) + +(with-test (:name (local-&optional-recursive-inline :bug-1180992)) + (compile nil + `(lambda () + (labels ((called (&optional a)) + (recursed (&optional b) + (called) + (recursed))) + (declare (inline recursed called)) + (recursed))))) +