1;; Simple test routines for the SLisp interpreter.
2
3(defun assert (exp)
4  (or (eval exp)
5      (princ "assertion failed: " exp " (:= " (eval exp) ")\n")))
6
7(defun asserteq (exp1 exp2)
8  (or (eq (eval exp1) (eval exp2))
9      (princ "assertion failed: " exp1 " (:= " (eval exp1) ") == "
10	     exp2 " (:= " (eval exp2) ")\n")))
11
12(defun assertn (exp)
13  (assert (list 'not exp)))
14
15(assert t)
16(assertn nil)
17(asserteq '() nil)
18
19;; `car', `cdr' test
20(assertn '(car '()))
21(assertn '(cdr '()))
22(asserteq '(car '(foo bar baz)) ''foo)
23(asserteq '(car (cdr '(foo bar baz))) ''bar)
24(asserteq '(car (cdr '(foo bar baz))) ''bar)
25(asserteq '(car (cdr (cdr '(foo bar baz)))) ''baz)
26(asserteq '(car (cdr (cdr (cdr '(foo bar baz))))) nil)
27
28;; `atom' test
29(assert '(atom t))
30(assert '(atom nil))
31(assert '(atom '()))
32(assertn '(atom '(foo)))
33(assertn '(atom '(foo bar baz)))
34
35;; `cons', `list' test
36(asserteq '(car (cons 'foo nil)) ''foo)
37(asserteq '(cdr (cons 'foo nil)) nil)
38(asserteq '(car (cdr (cons 'foo nil))) nil)
39(asserteq '(car (cdr (cons 'foo (cons 'bar)))) ''bar)
40(asserteq '(car (cons 'foo (cons 'bar))) ''foo)
41(asserteq '(cdr (cdr (cons 'foo (cons 'bar)))) nil)
42(asserteq '(car (list 'foo)) ''foo)
43(asserteq '(cdr (list 'foo)) nil)
44(asserteq '(car (cdr (list 'foo))) nil)
45(asserteq '(car (cdr (list 'nil 'bar))) ''bar)
46(asserteq '(car (list 'foo 'bar)) ''foo)
47(asserteq '(cdr (cdr (list 'foo 'bar))) nil)
48
49;; `and', `or', `not' test
50(assert '(and t))
51(assertn '(and n))
52(assert '(and t t))
53(assertn '(and nil nil))
54(assertn '(and t nil))
55(assertn '(and nil t))
56(assert '(or t))
57(assertn '(or n))
58(assert '(or t t))
59(assertn '(or nil nil))
60(assert '(or t nil))
61(assert '(or nil t))
62(assertn '(not t))
63(assert '(not nil))
64(assertn '(not 'foo))
65
66;; `if' test
67(assertn '(if t nil t t))
68(assert '(if nil nil t t))
69
70(assertn '(while nil t))
71
72;; `cond' test
73(assertn '(cond (nil t) (t nil)))
74(assertn '(cond (nil t) (nil t)))
75(assert '(cond (nil nil) (t t)))
76(assert '(cond (nil) (t)))
77(assertn '(cond (nil) (nil)))
78(asserteq '(cond (nil 'foo) (nil 'bar)) nil)
79(asserteq '(cond (nil 'foo) (t 'bar)) ''bar)
80(asserteq '(cond (t 'foo) (t 'bar)) ''foo)
81(asserteq '(cond (nil 'foo) (t 'bar 'baz)) ''baz)
82
83;; `progn' test
84(assertn '(progn t nil nil))
85(assert '(progn t nil nil t))
86(asserteq '(progn t nil nil 'foo) ''foo)
87(asserteq '(progn t nil nil 'foo 'bar) ''bar)
88(assert '(prog1 t nil nil))
89(assertn '(prog2 t nil t t))
90
91;; Recursion test
92(defun last* (l)
93  (cond ((eq (cdr l) nil) (car l))
94	(t (last* (cdr l)))))
95
96(asserteq '(last* '(foo bar baz)) ''baz)
97(asserteq '(last* '(foo bar)) ''bar)
98(asserteq '(last* '(foo)) ''foo)
99
100;; `cond*' test
101(or (eq cond* nil)
102    (progn (assertn '(cond* '((nil t) (t nil))))
103	   (assertn '(cond* '((nil t) (nil t))))
104	   (assert '(cond* '((nil nil) (t t))))
105	   (assert '(cond* '((nil) (t))))
106	   (assertn '(cond* '((nil) (nil))))
107	   (asserteq '(cond* '((nil 'foo) (nil 'bar))) nil)
108	   (asserteq '(cond* '((nil 'foo) (t 'bar))) ''bar)
109	   (asserteq '(cond* '((t 'foo) (t 'bar))) ''foo)
110	   (asserteq '(cond* '((nil 'foo) (t 'bar 'baz))) ''baz)))
111
112;; `progn*' test
113(or (eq progn* nil)
114    (progn (assertn '(progn* '(t nil nil)))
115	   (assert '(progn* '(t nil nil t)))
116	   (asserteq '(progn* '(t nil nil 'foo)) ''foo)
117	   (asserteq '(progn* '(t nil nil 'foo 'bar)) ''bar)))
118