~ chicken-core (chicken-5) /tests/inlining-tests.scm

 1;;;; inlining-tests.scm - test inlining
 2
 3
 4;;; SVN rev. 15495: local assignment did not mark lexical as "captured"
 5
 6(define (foo n)
 7  (let ((r #f))
 8    (for-each
 9     (lambda (m)
10       (case m
11	 ((abc) (set! r #t))
12	 ((def) (set! r 'ok))
13	 ((xyz) (set! r 'yo))))
14     n)
15    r))
16
17(assert (eq? #t (foo '(abc))))
18
19
20;;; SVN rev. 15511: multiple assignments didn't make global variable unknown for local inlining
21
22(define (bar)
23  (set! foo (lambda () 1)))
24
25(define (foo) 0)
26(bar)
27(assert (= 1 (foo)))
28
29(import inline-me)
30(assert (= 42 (foreign-foo 41)))
31
32;; #1665, don't replace calls to inlinable procedures with direct
33;; calls when those procedures are external (via an inline file).
34(module test-1665
35    ()
36
37  (import scheme inline-me)
38
39  (define (inline-external-with-unroll-limit-test x)
40    (lambda (x)
41      (lambda (a)
42	(if a
43            (external-foo x 'xxx)
44            (if x
45		(external-foo x 'yyy)
46		(external-foo x 'zzz)))
47	1)))
48
49  (inline-external-with-unroll-limit-test 'yo)
50  (inline-external-with-unroll-limit-test 'yo2))