~ chicken-core (chicken-5) /tests/rest-arg-tests.scm

 1;; Test rest argument optimizations
 2
 3;; Check that rest args are correctly fetched from a closure
 4(assert (equal? 1 ((lambda f0
 5		     (let ((v0 f0))
 6		       (let ((failure0
 7			      (lambda ()
 8				(if (pair? v0)
 9				    (car v0)))))
10			 (failure0))))
11		   1)))
12
13;; Check that rest arg optimizations aren't applied after inlining
14;; (#1658), slightly different from the above
15(assert (equal? 1 ((lambda f0
16		     (let ((v0 f0))
17		       (if (pair? v0)
18			   (car v0))))
19		   1)))
20
21;; Ensure that rest conversion is not applied too aggressively.
22;; (only when the consequence is () should it be applied)
23(define (rest-nonnull-optimization . rest)
24  (let ((x (if (null? (cdr rest))
25               '(foo)
26               (cdr rest))))
27    (null? x)))
28
29(assert (not (rest-nonnull-optimization 1)))
30(assert (not (rest-nonnull-optimization 1 2)))
31
32;; Regression test to make sure explicitly consed rest args don't get
33;; rest argvector ops for them (#1756)
34(let ()
35  (define mdplus
36    (lambda args
37      (let ((args args))
38        (if (pair? args)
39            (car args)))))
40  (mdplus '1 '2)
41  (mdplus '3 '4))