1;;;; module-tests-2.scm
2
3
4(module oo (output-of)
5  (import scheme chicken.port)
6  (define-syntax output-of
7    (syntax-rules ()
8      ((_ exp) (with-output-to-string (lambda () exp)))))
9)
10
11(module mscheme (lambda)
12  (import (rename scheme (lambda s:lambda))
13	  (chicken module))
14  (reexport (except scheme lambda))
15  (define-syntax lambda
16    (syntax-rules ()
17      ((_ llist . body)
18       (let ((results #f))
19	 (s:lambda
20	  llist
21	  (if results
22	      (apply values results)
23	      (call-with-values (s:lambda () . body)
24		(s:lambda rs
25		  (set! results rs)
26		  (apply values rs)))))))))
27)
28
29(module m (f1 f2)
30  (import mscheme)
31  (define (f1)
32    (display 'f1) (newline)
33    'f1)
34  (define f2
35    (lambda ()
36      (display 'f2) (newline)
37      'f2))
38)
39
40(module mtest ()
41  (import scheme m (chicken base) oo)
42  (assert (string=? "f1\n" (output-of (f1))))
43  (assert (string=? "f1\n" (output-of (f1))))
44  (assert (string=? "f2\n" (output-of (f2))))
45  (assert (string=? "" (output-of (f2)))))
46
47;;;
48
49(module m1 (lambda f1 f2)
50  (import (rename scheme (lambda s:lambda)))
51
52  (define-syntax lambda
53    (syntax-rules ()
54      ((_ llist . body)
55       (s:lambda llist (display 'llist) (newline) . body))))
56
57  (define (f1)				; should use standard lambda
58    (display 'f1)
59    (newline))
60
61  (define f2
62    (lambda (x)				; should be our lambda
63      (display 'f2)
64      (newline)))
65
66)
67
68(module mtest2 (f3 f4)
69  (import (except scheme lambda) m1 (chicken base) oo)
70
71  (define (f3)				; standard lambda
72    (display 'f3)
73    (newline))
74
75  (define f4				; our lambda
76    (lambda (x)
77      (display 'f4)
78      (newline)))
79
80  (assert (string=? "f1\n" (output-of (f1))))
81  (assert (string=? "(x)\nf2\n" (output-of (f2 'yes))))
82  (assert (string=? "f3\n" (output-of (f3))))
83  (assert (string=? "(x)\nf4\n" (output-of (f4 'yes)))))
84
85(module m2 ()
86  (import m1)
87  ((lambda () (f1)))) ; should use new lambda (but should be folded by compiler)
88
89
90;;; local define should work even with redefined define
91
92(module m3 ()
93  (import (rename scheme (define s:define)))
94  (import (only (chicken base) assert))
95  (define-syntax define
96    (syntax-rules ()
97      ((_) (display 'oink))))
98  (define)
99  (let ()
100    (define a 1)
101    (assert (= a 1)))
102  (define)
103  (newline))
104