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