1 # feature tests: variables
2 (assert "Evaluating undefined variable throws exception"
3 (throws? undefined-identifier "UndefinedIdentifierError"))
6 (assert "`car` retrieves first argument to `cons`"
7 (car (cons true false)))
8 (assert "`cdr` retrieves first argument to `cons`"
9 (cdr (cons false true)))
12 (assert "`=` returns true for equal numbers" (= 0 0))
13 (assert "`=` returns false for non-equal numbers" (not (= 0 1)))
14 (assert "`=` returns true for equal strings" (= "Hello, world" "Hello, world"))
15 (assert "`=` returns false for non-equal strings" (not (= "Hello, world" "Goodnight, moon")))
16 (assert "`=` returns true for equal true values" (= true true))
17 (assert "`=` returns true for equal false values" (= false false))
18 (assert "`=` returns true for nils" (= nil nil))
19 (assert "`=` returns true for equal symbols" (= :symbol :symbol))
20 (assert "`=` returns false for non-equal symbols" (not (= :symbol :not-the-same)))
21 (assert "`=` returns false for symbol-to-string comparison (string first)"
22 (not (= :symbol ":symbol")))
23 (assert "`=` returns false for symbol-to-string comparison (symbol first)"
24 (not (= ":symbol" :symbol)))
27 (assert "`+` adds" (= (+ 1 2) 3))
30 (assert "`-` subtracts" (= (- 3 2) 1))
33 (assert "`*` divides" (= (* 2 3) 6))
36 (assert "`/` divides evenly" (= (/ 6 3) 2))
37 (assert "`/` divides fractionally" (= (/ 7 2) 3.5))
40 (assert "`//` divides evenly" (= (// 6 3) 2))
41 (assert "`//` divides integrally" (= (// 7 2) 3))
44 (assert "`and` returns false for both false" (not (and false false)))
45 (assert "`and` returns false for left false and right true" (not (and false true)))
46 (assert "`and` returns false for left true and right false" (not (and true false)))
47 (assert "`and` returns true for both true" (and true true))
48 (assert "`and` doesn't evalueate second argument if first is false" (not (and false (/ 1 0))))
51 (assert "`assert` executes without exception for true assertion" true)
52 (assert "`assert` returns nil for true assertion" (= (assert true) nil))
53 (assert "`assert` throws AssertionError for false assertion"
54 (throws? (assert false) "AssertionError"))
55 (assert "`assert` throws TypeError for non-boolean assertion"
56 (throws? (assert 1) "TypeError"))
57 (assert "`assert` can take multiple arguments" false true)
58 (assert "`assert` executes assertion in a nested scope"
59 (assert "define identifier in nested scope"
60 (define identifier-in-nested-scope true)
62 (not (defined? identifier-in-nested-scope)))
64 # `merge-association-list-with-cons-dict` tests
65 (assert "merge-association-list-with-cons-dict returns cons-dict"
67 (cons-dict-get (merge-association-list-with-cons-dict (cons-list-zip (cons-list :key) (cons-list :value))
72 (assert "`concatenate` concatenates strings"
73 (= (concatenate "Hello, " "world")
77 (assert "`cond` returns nil for no conditions"
79 (assert "`cond` returns nil for no true conditions"
80 (= (cond (false :not-returned)
81 (false :also-not-returned))
83 (assert "`cond` returns true when pair evaluates to true"
84 (= (cond (false :not-returned)
86 (false :also-not-returned))
88 (assert "`cond` does not execute bodies for false conditions"
89 (= (cond (false (/ 1 0))
94 (assert "`cons-dict-get` returns association created by `cons-dict-set`"
95 (cons-dict-get (cons-dict-set nil :key true) :key))
98 (assert "`cons-list` first argument is first item"
99 (car (cons-list true)))
100 (assert "`cons-list` terminated by null cdr"
101 (= (cdr (cons-list false)) nil))
104 (assert "`cons-list?` returns true for nil"
106 (assert "`cons-list?` returns true for cons-list"
107 (cons-list? (cons-list 1 2 3)))
108 (assert "`cons-list?` returns false for non cons-list"
109 (not (cons-list? 1)))
111 # `cons-list-map` tests
112 (assert "`cons-list-map` returns empty list for empty list"
113 (= (cons-list-map identifier->symbol nil) nil))
114 (assert "`cons-list-map` calls mapping function on items"
115 (define inc (wrap (operative (i) _ (+ i 1))))
116 (define mapped (cons-list-map inc (cons-list 1 2)))
117 (and (= 2 (car mapped))
118 (= 3 (car (cdr mapped)))))
120 # `cons-list-zip` tests
121 (assert "`cons-list-zip` returns nil for empty lists"
122 (= (cons-list-zip nil nil) nil))
123 (assert "`cons-list-zip` returns association list"
124 (define a-list (cons-list-zip (cons-list :a) (cons-list :b)))
125 (and (= :a (car (car a-list)))
126 (= :b (cdr (car a-list)))))
129 (assert "`define` adds identifier to environment"
130 (define previously-undefined-identifier true)
131 previously-undefined-identifier)
132 (assert "`define` throws exception for already-defined variable"
133 (define already-defined-identifier :value)
134 (throws? (define already-defined-identifier :another-value) "AlreadyDefinedError"))
137 (assert "`defined?` returns true for defined identifier"
138 (define identifier :value)
139 (defined? identifier))
140 (assert "`defined?` returns false for undefined identifier"
141 (not (defined? undefined-identifier)))
144 (assert "`function` creates function that returns body"
146 (assert "`function` closes around defining environment"
147 (define defining-environment-identifier true)
148 ((function _ defining-environment-identifier)))
149 (assert "`function` with an identifier arg binding receives list"
150 (and (= ((function args (car args)) :arg) :arg)
151 (= ((function args (cdr args)) :arg) nil)))
152 (assert "`function` with an s-expression arg binding receives arguments bound to names"
153 (and (= ((function (foo bar) foo) :baz :qux) :baz)
154 (= ((function (foo bar) bar) :baz :qux) :qux)))
155 (assert "`function` can recurse"
156 (define factorial (function (n) (if (= n 1) 1 (* n (factorial (- n 1))))))
157 (and (= 6 (factorial 3))
158 (= 120 (factorial 5))))
160 # `get-current-environment` tests
161 (assert "`get-current-environment` contains local variables as symbols"
162 (define local-identifier true)
163 (cons-dict-get (get-current-environment) :local-identifier))
164 (assert "`get-current-environment` contains parent scope under :__parent__"
165 (define parent-identifier true)
166 (assert (cons-dict-get (cons-dict-get (get-current-environment) :__parent__) :parent-identifier))
169 # `identifier->symbol` tests
170 (assert "`identifier->symbol` returns a symbol when given an identifier"
171 (= (identifier->symbol (quote identifier)) :identifier))
173 # `identifier?` tests
174 (assert "`identifier?` returns true for identifier"
175 (identifier? (quote identifier)))
176 (assert "`identifier?` returns false for non-identifier"
177 (not (identifier? 1)))
180 (assert "`if` returns second argument for true condition"
181 (if true true false))
182 (assert "`if` returns third argument for false condition"
183 (if false false true))
184 (assert "`if` doesn't execute third argument for true condition"
185 (if true true undefined-identifier))
186 (assert "`if` doesn't execute second argument for false condition"
187 (if false undefined-identifier true))
190 (assert "`length` returns length of string"
191 (= 12 (length "Hello, world")))
194 (assert "`not` returns false for true" (= (not true) false))
195 (assert "`not` returns true for false" (= (not false) true))
196 (assert "`not` throws TypeError for non-boolean argument"
197 (throws? (not 1) "TypeError"))
200 (assert "`operative` creates callable operative"
201 ((operative () env true)))
202 (assert "`operative` receives the environment"
203 (define receives-environment (operative () env (evaluate (quote true-identifier) env)))
204 (define true-identifier true)
205 (receives-environment))
206 (assert "`operative` receives arguments"
207 ((operative (arg) env (evaluate arg env)) true))
208 (assert "`operative` executes in its own environment"
210 (define should-not-be-defined false)))
211 (not (defined? should-not-be-defined)))
212 (assert "`operative` doesn't evaluate its arguments"
213 ((operative (arg) env true) (/ 1 0)))
214 (assert "`operative` with a symbol argument receives a cons-linked-list"
215 (and (= ((operative argument-list env (car argument-list)) 1) 1)
216 (= ((operative argument-list env (cdr argument-list)) 1) nil)))
217 (assert "`operative` argument lists nest"
218 (and (= ((operative argument-list env (car (car argument-list))) (1)) 1)
219 (= ((operative argument-list env (cdr (car argument-list))) (1)) nil)))
220 (assert "`operative` with an s-expression argument still receives lists"
221 (and (= ((operative (arg) env (car arg)) (1)) 1)
222 (= ((operative (arg) env (cdr arg)) (1)) nil)))
223 (assert "`operative` executes body in a nested scope"
225 (define defined-in-nested-scope :value)
226 (assert (defined? defined-in-nested-scope))))
227 (not (defined? defined-in-nested-scope)))
228 (assert "`operative` with no args receives nil"
229 (= ((operative args-list _ args-list)) nil))
232 (assert "`or` returns false for both false" (not (or false false)))
233 (assert "`or` returns true for left false and right true" (or false true))
234 (assert "`or` returns true for left true and right false" (or true false))
235 (assert "`or` returns true for both true" (or true true))
236 (assert "`or` doesn't evalueate second argument if first is true" (or true (/ 1 0)))
239 (assert "`read` reads identifiers"
240 (= (identifier->symbol (read "identifier")) :identifier))
243 (assert "`slice` returns a slice of a string"
244 (= (slice "Hello, world" 1 11) "ello, worl"))
245 (assert "`slice` uses start of string if start index is nil"
246 (= (slice "Hello, world" nil 11) "Hello, worl"))
247 (assert "`slice` uses end of string if end index is nil"
248 (= (slice "Hello, world" 1 nil) "ello, world"))
249 (assert "`slice` counts backward if start or end is negative"
250 (= (slice "Hello, world" -11 -1) "ello, worl"))
253 (assert "`throws?` returns false when no exception is thrown"
254 (not (throws? (assert true) "AssertionError")))
255 (assert "`throws?` returns true when the correct exception is thrown"
256 (throws? (assert false) "AssertionError"))
257 (assert "`throws?` doesn't catch when the wrong exception is thrown"
258 (throws? (throws? (assert false) "TypeError") "AssertionError"))
261 (assert "`wrap` evaluates arguments to wrapped operative"
262 ((wrap (operative (input) _ input)) (= 1 1)))