source: project/chicken/trunk/tests/module-tests.scm @ 15171

Last change on this file since 15171 was 15171, checked in by felix winkelmann, 11 years ago

fix in foreign-value; tests use own repo; other fixes (thanks to sjaaman)

File size: 3.3 KB
Line 
1;;;; module-tests.scm
2
3
4(cond-expand
5 (compiling
6  (include "test.scm") )
7 (else
8  (load-relative "test.scm")))
9
10(test-begin "modules")
11
12(test-equal "internal/variable"
13(module foo (abc def)
14  (import scheme)
15  (define (abc x) (+ x 33))
16  (define-syntax def
17    (syntax-rules ()
18      ((_ x) (+ 99 (abc x)))))
19  (abc 1))
2034)
21
22(test-error "external/unimported variable (fail)" (abc 2))
23(test-error "external/unimported syntax (fail)" (def 3))
24
25(import foo)
26
27(test-equal "external/imported variable" (abc 4) 37)
28(test-equal "external/imported syntax" (def 5) 137)
29
30(module bar (x y)
31  (import (prefix scheme s:))
32  (s:define (x y) (s:* y 2))
33  (s:define y 1))
34
35(import (prefix (only (except (rename bar (x z)) y) z) "bar-"))
36(test-equal "modified import" (bar-z 10) 20)
37(test-error "hidden import" y)
38
39(module baz ((x s:list))
40  (import (prefix scheme s:))
41  (define-syntax x
42    (syntax-rules ()
43      ((_ x) (s:list x)))))
44
45(import baz)
46(test-equal "prefixed import and reexport" (x 1) '(1))
47
48(module m1 ((bar gna))
49  (import scheme)
50  (define (gna x) (list 'gna x))
51  (define-syntax bar
52    (syntax-rules ()
53      ((_ x) (baz x))))
54  (define-syntax baz
55    (syntax-rules ()
56      ((_ x) (gna 'x)))))
57
58(module m2 (run)
59  (import scheme chicken m1)
60  (define-syntax baz
61    (syntax-rules ()
62      ((_ x) (list 'goo 'x))))
63  (define (gna x) (print "ok."))
64  (define (run) (gna 9) (bar 99)))
65
66(import (only m2 run))
67(test-equal "indirect imports" (run) '(gna 99))
68
69(module m1 ((s1 f1))
70  (import scheme chicken)
71  (define (f1) (print "f1") 'f1)
72  (define-syntax s1
73    (syntax-rules ()
74      ((_) (f1)))))
75
76(module m2 (s2)
77  (import scheme m1)
78  (define-syntax s2
79    (syntax-rules ()
80      ((_) (s1)))))
81
82(module m3 (s3)
83  (import scheme m2)
84  (define-syntax s3
85    (syntax-rules ()
86      ((_) (s2)))))
87
88(import m3)
89(test-equal "chained indirect imports" (s3) 'f1)
90
91(module literal-compare-test (s1)
92  (import scheme)
93  (define-syntax s1
94    (syntax-rules (and)
95      ((_ (and x)) (list x))))
96)
97
98(import literal-compare-test)
99(test-equal "literal compare and export" (s1 (and 100)) '(100))
100
101(module y (y1)
102  (import scheme)
103  (define y1 10))
104
105(module x (magnitude)
106  (import (except scheme magnitude) y)
107  (define magnitude y1))
108
109(test-equal "redefinition of indirect import" (procedure? magnitude) #t)
110
111(import x)
112(test-equal "redefinition of indirect import (II)" magnitude 10)
113
114(module m10 (m10x m10y)
115  (import scheme)
116  (define m10x 99)
117  (define-syntax m10y
118    (syntax-rules ()
119      ((_ x) (list 'x)))))
120
121(module m11 (m10x m10y)
122  (import m10))
123
124(import m11)
125(test-equal "value reexport" m10x 99)
126(test-equal "syntax reexport" (m10y 3) '(3))
127
128;; found by Jim Ursetto;
129
130(module m12 (begin0)
131  (import scheme)
132  (define-syntax begin0
133    (syntax-rules ()
134      ((_ e0 e1 ...)
135       (##sys#call-with-values
136        (lambda () e0)
137        (lambda var
138          (begin
139            e1 ...
140            (apply ##sys#values var))))))))
141
142(test-equal "primitive indirect value-binding reexport"
143            (module m13 ()
144              (import m12)              ; note absence of "scheme"
145              (begin0 1 2 3))
146            1)
147
148(module m14 (test-extlambda)
149  (import chicken scheme)
150  (define (test-extlambda string #!optional whatever)
151    string))
152
153(import m14)
154
155(test-equal "extended lambda list uses expansion environment"
156            "some text"
157            (test-extlambda "some text"))
158
159(test-end "modules")
Note: See TracBrowser for help on using the repository browser.