Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 207 lines (154 sloc) 5.916 kB
6f15155 @itfrombit Added defmacro and quasiquote support.
itfrombit authored
1 ;; test_macrox.nu
2 ;; tests for Nu macro-expand operator.
3 ;;
4 ;; Copyright (c) 2008 Jeff Buck
5
6 (class TestMacrox is NuTestCase
7
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
8 (- (id) testIncMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
9 (macro inc! (n)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
10 `(set ,n (+ ,n 1)))
11
12 ;; Test the macro evaluation
13 (set a 0)
14 (inc! a)
15 (assert_equal 1 a)
16
17 ;; Test the expansion
18 (set newBody (macrox (inc! a)))
19 (assert_equal "(set a (+ a 1))" (newBody stringValue)))
20
21 (- (id) testNestedMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
22 (macro inc! (n)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
23 `(set ,n (+ ,n 1)))
24
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
25 (macro inc2! (n)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
26 `(progn
27 (inc! ,n)
28 (inc! ,n)))
29
30 (set a 0)
31 (inc2! a)
32 (assert_equal 2 a)
33
34 (set newBody (macrox (inc2! a)))
35 (assert_equal "(progn (inc! a) (inc! a))" (newBody stringValue)))
36
37
38 (- (id) testFactorialMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
39 (macro mfact (n)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
40 `(if (== ,n 0)
41 (then 1)
42 (else (* (mfact (- ,n 1)) ,n))))
43
44 (set newBody (macrox (mfact x)))
45 (assert_equal "(if (== x 0) (then 1) (else (* (mfact (- x 1)) x)))" (newBody stringValue))
46
47 (set x 4)
48
49 (assert_equal 24 (mfact x)))
50
51 (- (id) testCallingContextForMacro is
52 ;; Make sure we didn't ruin our calling context
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
53 (macro mfact (n)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
54 `(if (== ,n 0)
55 (then 1)
56 (else (* (mfact (- ,n 1)) ,n))))
57 (set n 10)
58 (mfact 4)
59 (assert_equal 10 n))
60
61
62 (- (id) testRestMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
63 (macro myfor ((var start stop) *body)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
64 `(let ((,var ,start))
65 (while (<= ,var ,stop)
66 ,@*body
67 (set ,var (+ ,var 1)))))
68
69 (set var 0)
70 (myfor (i 1 10)
71 (set var (+ var i)))
72 (assert_equal 55 var)
73
74 ;; Make sure we didn't pollute our context
75 (assert_throws "NuUndefinedSymbol"
76 (puts "#{i}")))
77
78 (- (id) testNullArgMacro is
79 ;; Make sure *args is set correctly with a null arg macro
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
80 (macro set-a-to-1 ()
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
81 (set a 1))
82
83 (set-a-to-1)
84 (assert_equal 1 a))
85
86 (- (id) testBadArgsNullMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
87 (macro nullargs ()
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
88 nil)
89
90 (assert_throws "NuDestructureException" (nullargs 1 2)))
91
92 (- (id) testNoBindingsMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
93 (macro no-bindings (_)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
94 nil)
95
96 (assert_equal nil (no-bindings 1)))
97
98 (- (id) testMissingSequenceArgument is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
99 (macro missing-sequence (_ b)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
100 b)
101
102 (assert_throws "NuDestructureException" (missing-sequence 1)))
103
104 (- (id) testSkipBindingsMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
105 (macro skip-bindings (_ b)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
106 b)
107
108 (assert_equal 2 (skip-bindings 1 2)))
109
110 (- (id) testSingleCatchAllArgMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
111 (macro single-arg (*rest)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
112 (cons '+ *rest))
113
114 (assert_equal 6 (single-arg 1 2 3)))
115
116 (- (id) testDoubleCatchAllArgMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
117 (macro double-catch-all ((a *b) (c *d))
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
118 `(append (quote ,*b) (quote ,*d)))
119
120 (assert_equal '(2 3 4 12 13 14) (double-catch-all (1 2 3 4) (11 12 13 14))))
121
122 (- (id) testRestoreImplicitArgsExceptionMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
123 (macro concat ()
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
124 (cons '+ *args))
125
126 (assert_throws "NuDestructureException" (concat 1 2 3))
127
128 ;; We're in a block, so *args is defined
129 ;; but should be nil since our block takes
130 ;; no arguments.
131
132 ;; Don't pass *args to another macro
133 (set defaultargs *args)
134 (assert_equal nil defaultargs))
135
136 (- (id) testRestoreArgsExceptionMacro is
137 ;; Intentionally refer to undefined symbol
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
138 (macro x (a b)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
139 c)
140
141 (set a 0)
142 (assert_throws "NuUndefinedSymbol" (x 1 2))
143
144 ;; Don't pass *args to another macro
145 (set defaultargs *args)
146 (assert_equal nil defaultargs)
147 (assert_equal 0 a)
148 (assert_throws "NuUndefinedSymbol" b))
149
150 (- (id) testEvalExceptionMacro is
151 ;; Make sure a runtime exception is properly caught
152 (set code '(+ 2 x))
153
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
154 (macro eval-it (sexp) `(eval ,sexp))
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
155 (assert_throws "NuUndefinedSymbol" (eval-it code)))
156
157 (- (id) testMaskedVariablesMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
158 (macro x (a b)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
159 `(+ ,a ,b))
160
161 (set a 1)
162 (assert_equal 5 (x 2 3))
163 (assert_equal 1 a))
164
165 (- (id) testEmptyListArgsMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
166 (macro donothing (a b)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
167 b)
168
169 (assert_equal 2 (donothing 1 2))
170 (assert_equal 2 (donothing () 2))
171 (assert_equal 2 (donothing nil 2)))
172
173 (- (id) testEmptyListArgsRecursiveMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
174 (macro let* (bindings *body)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
175 (if (null? *body)
176 (then
177 (throw* "LetException"
178 "An empty body was passed to let*")))
179 (if (null? bindings)
180 (then
181 `(progn
182 ,@*body))
183 (else
184 (set __nextcall `(let* ,(cdr bindings) ,@*body))
185 `(let (,(car bindings))
186 ,__nextcall))))
187
188 (assert_equal 3
189 (let* ((a 1)
190 (b (+ a a)))
191 (+ a b)))
192
193 (assert_equal 3
194 (let* ()
195 (+ 2 1)))
196
197 (assert_throws "LetException"
198 (let* () )))
199
200 (- (id) testDisruptCallingContextMacro is
0d12b48 @timburks removing macro-0 and macro-1 operators. "macro" is "macro-1".
authored
201 (macro leaky-macro (a b)
045f219 @timburks Replace "cmethod" and "imethod" with "+" and "-".
authored
202 `(set c (+ ,a ,b)))
203
204 (assert_equal 5 (leaky-macro 2 3))
205 (assert_equal 5 c)))
54f6634 @itfrombit Removed macro-0 from .nu files and tools. One regression remains for …
itfrombit authored
206
Something went wrong with that request. Please try again.