1.0.48.25: automatic &rest to &more conversion

[sbcl.git] / tests / dynamic-extent.impure.lisp

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 912b44e..16aa5e9 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -928,3 +928,75 @@
 (with-test (:name :rest-stops-dynamic-extent)
   (assert (rest-stops-dx-ok)))
 
+;;;; These tests aren't strictly speaking DX, but rather &REST -> &MORE
+;;;; conversion.
+(with-test (:name :rest-to-more-conversion)
+  (let ((f1 (compile nil `(lambda (f &rest args)
+                            (apply f args)))))
+    (assert-no-consing (assert (eql f1 (funcall f1 #'identity f1)))))
+  (let ((f2 (compile nil `(lambda (f1 f2 &rest args)
+                            (values (apply f1 args) (apply f2 args))))))
+    (assert-no-consing (multiple-value-bind (a b)
+                           (funcall f2 (lambda (x y z) (+ x y z)) (lambda (x y z) (- x y z))
+                                    1 2 3)
+                         (assert (and (eql 6 a) (eql -4 b))))))
+  (let ((f3 (compile nil `(lambda (f &optional x &rest args)
+                            (when x
+                              (apply f x args))))))
+    (assert-no-consing (assert (eql 42 (funcall f3
+                                                (lambda (a b c) (+ a b c))
+                                                11
+                                                10
+                                                21)))))
+  (let ((f4 (compile nil `(lambda (f &optional x &rest args &key y &allow-other-keys)
+                            (apply f y x args)))))
+    (assert-no-consing (funcall f4 (lambda (y x yk y2 b c)
+                                     (assert (eq y 'y))
+                                     (assert (= x 2))
+                                     (assert (eq :y yk))
+                                     (assert (eq y2 'y))
+                                     (assert (eq b 'b))
+                                     (assert (eq c 'c)))
+                                2 :y 'y 'b 'c)))
+  (let ((f5 (compile nil `(lambda (a b c &rest args)
+                            (apply #'list* a b c args)))))
+    (assert (equal '(1 2 3 4 5 6 7) (funcall f5 1 2 3 4 5 6 '(7)))))
+  (let ((f6 (compile nil `(lambda (x y)
+                            (declare (optimize speed))
+                            (concatenate 'string x y)))))
+    (assert (equal "foobar" (funcall f6 "foo" "bar"))))
+  (let ((f7 (compile nil `(lambda (&rest args)
+                            (lambda (f)
+                              (apply f args))))))
+    (assert (equal '(a b c d e f) (funcall (funcall f7 'a 'b 'c 'd 'e 'f) 'list))))
+  (let ((f8 (compile nil `(lambda (&rest args)
+                            (flet ((foo (f)
+                                     (apply f args)))
+                              #'foo)))))
+    (assert (equal '(a b c d e f) (funcall (funcall f8 'a 'b 'c 'd 'e 'f) 'list))))
+  (let ((f9 (compile nil `(lambda (f &rest args)
+                            (flet ((foo (g)
+                                     (apply g args)))
+                              (declare (dynamic-extent #'foo))
+                              (funcall f #'foo))))))
+    (assert (equal '(a b c d e f)
+                   (funcall f9 (lambda (f) (funcall f 'list)) 'a 'b 'c 'd 'e 'f))))
+  (let ((f10 (compile nil `(lambda (f &rest args)
+                            (flet ((foo (g)
+                                     (apply g args)))
+                              (funcall f #'foo))))))
+    (assert (equal '(a b c d e f)
+                   (funcall f10 (lambda (f) (funcall f 'list)) 'a 'b 'c 'd 'e 'f))))
+  (let ((f11 (compile nil `(lambda (x y z)
+                             (block out
+                               (labels ((foo (x &rest rest)
+                                          (apply (lambda (&rest rest2)
+                                                   (return-from out (values-list rest2)))
+                                                 x rest)))
+                                (if x
+                                    (foo x y z)
+                                    (foo y z x))))))))
+    (multiple-value-bind (a b c) (funcall f11 1 2 3)
+      (assert (eql a 1))
+      (assert (eql b 2))
+      (assert (eql c 3)))))