2375 lines
60 KiB
Plaintext
2375 lines
60 KiB
Plaintext
;;; LISP9 Test Suite
|
|
;;; By Nils M Holm, 2007-2019
|
|
;;; In the public domain
|
|
|
|
; This is a comment
|
|
|
|
;; Prelude
|
|
|
|
(def *Verbose* (and (> (length (cmdline)) 0)
|
|
(s= (car (cmdline)) "-v")))
|
|
|
|
(def testfile "test.tmp")
|
|
(def testfile2 "test2.tmp")
|
|
(def logfile "test.log")
|
|
|
|
(if (existsp testfile) (delete testfile))
|
|
(if (existsp logfile) (delete logfile))
|
|
|
|
(def Errors 0)
|
|
|
|
(defun (void) (if nil nil))
|
|
|
|
(defun (seq)
|
|
(let ((n 0))
|
|
(lambda ()
|
|
(setq n (+ 1 n)))))
|
|
|
|
(defun (fail expr result expected port)
|
|
(princ "test failed: " port)
|
|
(prin expr port)
|
|
(terpri port)
|
|
(princ "got result: " port)
|
|
(prin result port)
|
|
(terpri port)
|
|
(princ "expected: " port)
|
|
(prin expected port)
|
|
(terpri port))
|
|
|
|
(defun (test3 expr result expected)
|
|
(cond (*Verbose*
|
|
(prin expr)
|
|
(princ " => ")
|
|
(prin result)
|
|
(print)))
|
|
(cond ((not (equal result expected))
|
|
(setq Errors (+ 1 Errors))
|
|
(fail expr result expected (outport))
|
|
(fail expr result expected (open-outfile logfile t)))))
|
|
|
|
(defmac (test form expected)
|
|
@(test3 ',form (catch-errors ('error) ,form) ,expected))
|
|
|
|
(defmac (test form expected)
|
|
@(test3 ',form ,form ,expected))
|
|
|
|
;; Syntax
|
|
|
|
; Special objects
|
|
|
|
(test t t)
|
|
(test 't t)
|
|
(test nil nil)
|
|
(test 'nil nil)
|
|
|
|
; Symbols
|
|
|
|
(test 'x 'x)
|
|
(test 'mississippi 'mississippi)
|
|
(test 'MIssissiPPi 'mississippi)
|
|
(test '!$%&*+-./^_ '!$%&*+-./^_)
|
|
|
|
; Chars
|
|
|
|
(test #\x #\x)
|
|
(test #\C #\C)
|
|
(test #\( #\()
|
|
(test #\) #\))
|
|
(test #\; #\;)
|
|
(test #\ht #\ht)
|
|
(test #\nl #\nl)
|
|
(test #\sp #\sp)
|
|
(test #\Sp #\sp)
|
|
(test #\SP #\sp)
|
|
(test #\\11 #\ht)
|
|
(test #\\12 #\nl)
|
|
(test #\\40 #\sp)
|
|
(test #\\33 #\\33)
|
|
|
|
; Strings
|
|
|
|
(test "test" "test")
|
|
(test "TeSt" "TeSt")
|
|
(test "TEST" "TEST")
|
|
(test "hello, world!" "hello, world!")
|
|
(test "\"hello, world!\"" "\"hello, world!\"")
|
|
(test "a\\/b" "a\\/b")
|
|
(test "(((;)))" "(((;)))")
|
|
(test "The word \"recursion\" has many meanings."
|
|
"The word \"recursion\" has many meanings.")
|
|
|
|
(test (sref "\t" 0) #\ht)
|
|
(test (sref "\n" 0) #\nl)
|
|
(test (sref " " 0) #\sp)
|
|
(test (sref "\123" 0) #\S)
|
|
(test (sref "\0123" 0) #\nl)
|
|
(test (sref "\0123" 1) #\3)
|
|
(test (s= "\0foo" "\0foo") t)
|
|
(test (s= "\0foo" "\0bar") nil)
|
|
(test (s< "\0bar" "\0foo") t)
|
|
|
|
; Pairs
|
|
|
|
(test nil nil)
|
|
(test '(a b c) '(a b c))
|
|
(test '(a (b) c) '(a (b) c))
|
|
(test '(((((x))))) '(((((x))))))
|
|
(test '((caar . cdar) . (cadr . cddr)) '((caar . cdar) . (cadr . cddr)))
|
|
(test '(a . (b . (c . (d . (e . ()))))) '(a b c d e))
|
|
(test '(a . (b . (c . d))) '(a b c . d))
|
|
|
|
; Vectors
|
|
|
|
(test #() #())
|
|
(test #(a b c) #(a b c))
|
|
(test #(a (b) c) #(a (b) c))
|
|
(test #(((((x))))) #(((((x))))))
|
|
(test #((caar cadar) (caadr cadadr)) #((caar cadar) (caadr cadadr)))
|
|
(test #(#(a b c) #(d e f)) #(#(a b c) #(d e f)))
|
|
(test #(#(#(#(#(x))))) #(#(#(#(#(x))))))
|
|
|
|
; Fixnums
|
|
|
|
(test 0 0)
|
|
(test 1 1)
|
|
(test 1234 1234)
|
|
(test -0 0)
|
|
(test -1 -1)
|
|
(test -1234 -1234)
|
|
|
|
(test #2r10101010 170)
|
|
(test #2r-10101010 -170)
|
|
(test #2r+10101010 170)
|
|
(test #8r1357 751)
|
|
(test #10r1234 1234)
|
|
(test #16rdef 3567)
|
|
(test #36rzz 1295)
|
|
(test #36r-zz -1295)
|
|
(test #36r+zz 1295)
|
|
|
|
;; Binding constructs
|
|
|
|
; DEF
|
|
|
|
(def x 'foo)
|
|
(test x 'foo)
|
|
(def f (lambda (x) (cons x x)))
|
|
(test (f 1) '(1 . 1))
|
|
|
|
; DEFUN
|
|
|
|
(defun (f2 x) (+ 1 x))
|
|
(test (f2 0) 1)
|
|
|
|
(defun (f3 x)
|
|
(defun (g x)
|
|
(+ x 2))
|
|
(+ 1 (g x)))
|
|
(test (f3 0) 3)
|
|
|
|
(defun (f4 x)
|
|
(defun (e x) (or (= 0 x) (o (- x 1))))
|
|
(defun (o x) (if (= 0 x) nil (e (- x 1))))
|
|
(list (e x) (o x)))
|
|
(test (f4 5) '(nil t))
|
|
|
|
; LAMBDA
|
|
|
|
(test ((lambda () nil)) nil)
|
|
(test ((lambda (x) x) 1) 1)
|
|
(test ((lambda (x y z) (list x y z)) 1 2 3) '(1 2 3))
|
|
|
|
(test (((lambda (x) (lambda (y) (cons x y))) 1) 2) '(1 . 2))
|
|
|
|
(test ((lambda (a . b) a) 'foo) 'foo)
|
|
(test ((lambda (a . b) b) 'foo) nil)
|
|
(test ((lambda (a . b) b) 'foo 'bar) '(bar))
|
|
(test ((lambda (a . b) b) 'foo 'bar 'baz) '(bar baz))
|
|
|
|
(test ((lambda (a b . c) a) 'foo 'bar) 'foo)
|
|
(test ((lambda (a b . c) b) 'foo 'bar) 'bar)
|
|
(test ((lambda (a b . c) c) 'foo 'bar) nil)
|
|
(test ((lambda (a b . c) c) 'foo 'bar 'baz) '(baz))
|
|
|
|
(test ((lambda a a)) nil)
|
|
(test ((lambda a a) 'foo) '(foo))
|
|
(test ((lambda a a) 'foo 'bar) '(foo bar))
|
|
(test ((lambda a a) 'foo 'bar 'baz) '(foo bar baz))
|
|
|
|
(test ((lambda (x) ((lambda () x))) 1) 1)
|
|
|
|
(test ((lambda () 1 2 3)) 3)
|
|
|
|
(test ((lambda (x) ((lambda () (setq x 1))) x) 0) 1)
|
|
|
|
(def compose
|
|
(lambda (f g)
|
|
(lambda args
|
|
(f (apply g args)))))
|
|
|
|
(defun (isqrt square)
|
|
(labels
|
|
((sqrt2 (lambda (x last)
|
|
(cond ((= last x)
|
|
x)
|
|
((= last (+ 1 x))
|
|
(if (> (* x x) square) (- x 1) x))
|
|
(else
|
|
(sqrt2 (div (+ x (div square x))
|
|
2)
|
|
x))))))
|
|
(sqrt2 square 0)))
|
|
|
|
(test ((compose isqrt *) 12 75) 30)
|
|
|
|
; LET
|
|
|
|
(test (let () 1) 1)
|
|
(test (let () 1 2 3) 3)
|
|
(test (let ((x 1)) x) 1)
|
|
(test (let ((x 1) (y 2) (z 3)) (list x y z)) '(1 2 3))
|
|
|
|
(test (let ((x 0))
|
|
(let ((x 1)
|
|
(y (* x 1)))
|
|
y))
|
|
0)
|
|
(test (let ((x 0))
|
|
(let ((x 1))
|
|
(let ((y (* x 1)))
|
|
y)))
|
|
1)
|
|
|
|
; LET*
|
|
|
|
(test (let* () 1) 1)
|
|
(test (let* () 1 2 3) 3)
|
|
(test (let* ((x 'first)) x) 'first)
|
|
(test (let* ((x 'first) (y 'second) (z 'third)) (list x y z))
|
|
'(first second third))
|
|
(test (let* ((x 0))
|
|
(let* ((x 1)
|
|
(y (* x 5)))
|
|
y))
|
|
5)
|
|
(test (let* ((x 3)
|
|
(y (cons 2 x))
|
|
(z (cons 1 y)))
|
|
z)
|
|
'(1 2 . 3))
|
|
(test (let* ((x 3)
|
|
(x (cons 2 x))
|
|
(x (cons 1 x)))
|
|
x)
|
|
'(1 2 . 3))
|
|
|
|
; LABELS
|
|
|
|
(test (labels () 1) 1)
|
|
(test (labels () 1 2 3) 3)
|
|
(test (labels ((x 1)) x) 1)
|
|
(test (labels ((x 1) (y 2) (z 3)) (list x y z)) '(1 2 3))
|
|
|
|
(test (labels
|
|
((even-p
|
|
(lambda (x)
|
|
(or (null x) (odd-p (cdr x)))))
|
|
(odd-p
|
|
(lambda (x)
|
|
(if (null x) nil (even-p (cdr x))))))
|
|
(list (odd-p '(i i i i i))
|
|
(even-p '(i i i i i))))
|
|
'(t nil))
|
|
|
|
; WITH
|
|
|
|
(def *p1* 'value-1)
|
|
(def *p2* 'value-2)
|
|
(def *p3* 'value-3)
|
|
|
|
(test (with () *p1*) 'value-1)
|
|
|
|
(test *p1* 'value-1)
|
|
|
|
(test (with ((*p1* 'modified-1)
|
|
(*p2* 'modified-2)
|
|
(*p3* 'modified-3))
|
|
(list *p1* *p2* *p3*))
|
|
'(modified-1 modified-2 modified-3))
|
|
|
|
(test *p1* 'value-1)
|
|
(test *p2* 'value-2)
|
|
(test *p3* 'value-3)
|
|
|
|
;; Conditionals
|
|
|
|
; AND
|
|
|
|
(test (and) t)
|
|
(test (and nil) nil)
|
|
(test (and nil nil) nil)
|
|
(test (and nil t) nil)
|
|
(test (and t nil) nil)
|
|
(test (and t t) t)
|
|
(test (and 1 2 3) 3)
|
|
(test (and nil 2 3) nil)
|
|
(test (and 1 nil 3) nil)
|
|
(test (and 1 2 nil) nil)
|
|
(test (and 'foo) 'foo)
|
|
(test (and t) t)
|
|
(test (and 1) 1)
|
|
(test (and #\x) #\x)
|
|
(test (and "x") "x")
|
|
(test (and '(x)) '(x))
|
|
(test (and nil) nil)
|
|
(test (and #(x)) #(x))
|
|
(test (and (lambda (x) x) t) t)
|
|
|
|
; CASE
|
|
|
|
(test (case 'a ((a b) 'first) ((c d) 'second)) 'first)
|
|
(test (case 'b ((a b) 'first) ((c d) 'second)) 'first)
|
|
(test (case 'c ((a b) 'first) ((c d) 'second)) 'second)
|
|
(test (case 'd ((a b) 'first) ((c d) 'second)) 'second)
|
|
(test (case 'x ((a b) 'first) ((c d) 'second)) (void))
|
|
(test (case 'x ((a b) 'first) (else 'default)) 'default)
|
|
(test (case 'd ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'default)
|
|
(test (case 'c ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'c)
|
|
(test (case 'b ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'b)
|
|
(test (case 'a ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'a)
|
|
(test (case 'x ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'default)
|
|
(test (case 'x ((b) 'b) ((c) 'c) (else 'default)) 'default)
|
|
(test (case 'x ((c) 'c) (else 'default)) 'default)
|
|
(test (case 'x (else 'default)) 'default)
|
|
(test (case 1 ((1) t)) t)
|
|
(test (case #\c ((#\c) t)) t)
|
|
(test (case 'x (else 1 2 3)) 3)
|
|
(test (case 'x ((y) nil)) (void))
|
|
|
|
; COND
|
|
|
|
(test (cond) (void))
|
|
(test (cond (t 1)) 1)
|
|
(test (cond (1 1)) 1)
|
|
(test (cond ('x 1)) 1)
|
|
(test (cond (#\x 1)) 1)
|
|
(test (cond ("x" 1)) 1)
|
|
(test (cond ('(a b c) 1)) 1)
|
|
(test (cond (#(1 2 3) 1)) 1)
|
|
(test (cond (nil 1)) (void))
|
|
(test (cond (nil 1) (t 2)) 2)
|
|
(test (cond (nil 1) (else 2)) 2)
|
|
(test (cond (else 2)) 2)
|
|
(test (cond (t 1 2 3)) 3)
|
|
(test (cond (else 1 2 3)) 3)
|
|
(test (cond (nil (nil))) (void))
|
|
(test (cond (nil)) (void))
|
|
(test (cond (nil) (t)) t)
|
|
(test (cond (1 => list)) '(1))
|
|
(test (cond (nil => list) (t => list)) '(t))
|
|
(test (cond (1)) 1)
|
|
(test (cond ('foo)) 'foo)
|
|
(test (cond (nil)) nil)
|
|
(test (cond ('(()))) '(()))
|
|
|
|
; IF
|
|
|
|
(test (if nil nil) (void))
|
|
(test (if t 1) 1)
|
|
(test (if 1 1) 1)
|
|
(test (if 'a 1) 1)
|
|
(test (if #\a 1) 1)
|
|
(test (if "a" 1) 1)
|
|
(test (if '(1 2 3) 1) 1)
|
|
(test (if nil 1) (void))
|
|
(test (if #(1 2 3) 1) 1)
|
|
(test (if t 1 2) 1)
|
|
(test (if nil 1 2) 2)
|
|
(test (if nil (nil)) (void))
|
|
|
|
; IF*
|
|
|
|
(test (if* t 2) t)
|
|
(test (if* 1 2) 1)
|
|
(test (if* 'a 2) 'a)
|
|
(test (if* #\a 2) #\a)
|
|
(test (if* "a" 2) "a")
|
|
(test (if* '(1 2 3) 2) '(1 2 3))
|
|
(test (if* #(1 2 3) 2) #(1 2 3))
|
|
(test (if* nil 2) 2)
|
|
(test (if* t (nil)) t)
|
|
|
|
; OR
|
|
|
|
(test (or) nil)
|
|
(test (or nil) nil)
|
|
(test (or nil nil) nil)
|
|
(test (or nil t) t)
|
|
(test (or t nil) t)
|
|
(test (or t t) t)
|
|
(test (or 1 2 3) 1)
|
|
(test (or nil 2 3) 2)
|
|
(test (or 1 nil 3) 1)
|
|
(test (or nil nil 3) 3)
|
|
(test (or 'foo) 'foo)
|
|
(test (or t) t)
|
|
(test (or 1) 1)
|
|
(test (or #\x) #\x)
|
|
(test (or "x") "x")
|
|
(test (or '(x)) '(x))
|
|
(test (or nil) nil)
|
|
(test (or #(x)) #(x))
|
|
|
|
;; Loops
|
|
|
|
; DO
|
|
|
|
(test (do () (t 123)) 123)
|
|
(test (prog (do () (t)) 1) 1)
|
|
(test (do ((i 1 (+ 1 i))) ((= i 10) i) i) 10)
|
|
(test (do ((i 1 (+ 1 i)) (j 17)) ((= i 10) j) i) 17)
|
|
(test (do ((i 1 (+ 1 i)) (j 2 (+ 2 j))) ((= i 10) j) i) 20)
|
|
(test (do ((i 1 (+ 1 i)) (j 2 (+ 2 j))) ((= i 10) (* i j)) i) 200)
|
|
(test (let ((j 1)) (do ((i 0 (+ 1 i))) ((= i 10) j) (setq j (+ j 3)))) 31)
|
|
(test (do ((i 1 (+ 1 i)) (j 0)) ((= i 10) j) (setq j 1)) 1)
|
|
(test (do ((i 1 (+ 1 i)) (j 0)) ((= i 10) j) 1 2 3 (setq j 1)) 1)
|
|
|
|
; named LET
|
|
|
|
(test (let loop ((i 0)) (if (< i 10) (loop (+ 1 i)) i)) 10)
|
|
(test (let loop ((i 0) (j 1)) (if (< i 10) (loop (+ 1 i) (* 2 j)) j)) 1024)
|
|
|
|
;; Sequences
|
|
|
|
; PROG
|
|
|
|
(test (prog) nil)
|
|
(test (prog 1) 1)
|
|
(test (prog 1 "2") "2")
|
|
(test (prog 1 "2" #\3) #\3)
|
|
(test (let ((x (seq)) (y 0))
|
|
(prog (setq y (- y (x)))
|
|
(setq y (- y (x)))
|
|
(setq y (- y (x))))
|
|
y)
|
|
-6)
|
|
|
|
;; Quotation
|
|
|
|
; QUOTE
|
|
|
|
(test (quote foo) 'foo)
|
|
(test (quote quote) 'quote)
|
|
(test (quote t) t)
|
|
(test (quote 1) 1)
|
|
(test (quote #\X) #\X)
|
|
(test (quote "abc") "abc")
|
|
(test (quote ()) nil)
|
|
(test (quote (1 2 3)) '(1 2 3))
|
|
(test (quote #(1 2 3)) #(1 2 3))
|
|
(test (quote (lambda (x) x)) '(lambda (x) x))
|
|
(test '1 '1)
|
|
(test ''1 ''1)
|
|
(test '''1 '''1)
|
|
(test 'nil nil)
|
|
(test '1 1)
|
|
(test '#\b #\b)
|
|
(test '"abc" "abc")
|
|
|
|
; QUASIQUOTE
|
|
|
|
(def x 'foo)
|
|
(test `x 'x)
|
|
(test `,x 'foo)
|
|
(test @(1 2 3) '(1 2 3))
|
|
(test @(y ,x z) '(y foo z))
|
|
(test @(1 2 3 ,(list 4 5)) '(1 2 3 (4 5)))
|
|
(test @(1 2 3 ,@(list 4 5)) '(1 2 3 4 5))
|
|
(test `#(y ,x z) #(y foo z))
|
|
(test `#(1 2 3 ,(list 4 5)) #(1 2 3 (4 5)))
|
|
(test `#(1 2 3 ,@(list 4 5)) #(1 2 3 4 5))
|
|
(test @(a b c (,x y z)) '(a b c (foo y z)))
|
|
(test @(a b c (,x ,@(list 'y 'z))) '(a b c (foo y z)))
|
|
(test @(+ 1 ,(* 2 `,(* 3 4))) '(+ 1 24))
|
|
(test @(+ 1 (car '(,@(memv 2 `,(list 1 (+ 1 1) 3))))) '(+ 1 (car '(2 3))))
|
|
|
|
;; Macros
|
|
|
|
(test (symbolp (gensym)) t)
|
|
(macro kwote (lambda (x) (list 'quote x)))
|
|
(test (kwote (list 1 2 3)) '(list 1 2 3))
|
|
|
|
(defmac (kwote x) (list 'quote x)) ; redefine
|
|
(test (kwote (list 1 2 3)) '(list 1 2 3))
|
|
|
|
(defmac (times n)
|
|
(if (= 0 n)
|
|
nil
|
|
@(cons 1 (times ,(- n 1)))))
|
|
(test (times 0) '())
|
|
(test (times 1) '(1))
|
|
(test (times 10) '(1 1 1 1 1 1 1 1 1 1))
|
|
|
|
(test (mx '(times 3)) '(cons 1 (cons 1 (cons 1 ()))))
|
|
(test (mx1 '(times 3)) '(cons 1 (times 2)))
|
|
|
|
(defmac (labels* bs x . xs)
|
|
(let ((vs (mapcar car bs))
|
|
(as (mapcar cadr bs)))
|
|
(let ((undefs (mapcar (lambda (v) (list v nil))
|
|
vs))
|
|
(updates (mapcar (lambda (v w) (list 'set! v w))
|
|
vs
|
|
as)))
|
|
@(let ,undefs
|
|
,@updates
|
|
(let ()
|
|
,x
|
|
,@xs)))))
|
|
|
|
(test (mx '(labels* ((a 1) (b 2)) (a b)))
|
|
'((lambda (a b) (set! a 1) (set! b 2) ((lambda () (a b)))) nil nil))
|
|
(test (mx1 '(labels* ((a 1) (b 2)) (a b)))
|
|
'(let ((a nil) (b nil)) (set! a 1) (set! b 2) (let () (a b))))
|
|
|
|
;; Setters
|
|
|
|
(def x 0)
|
|
(test (prog (setq x 1) x) 1)
|
|
(test (prog ((lambda (x) (setq x 0)) 'void) x) 1)
|
|
(test (prog (let ((x 'void)) (setq x 0)) x) 1)
|
|
(test (prog (let* ((x 'void)) (setq x 0)) x) 1)
|
|
(test (prog (labels ((x 'void)) (setq x 0)) x) 1)
|
|
(test (prog (setq x 2) x) 2)
|
|
|
|
(def p (cons 1 2))
|
|
(test (prog (setcar p 'a) p) '(a . 2))
|
|
(test (prog (setcdr p 'b) p) '(a . b))
|
|
|
|
;; Type Predicates
|
|
|
|
(test (constp '(1 2 3)) t)
|
|
(test (constp (list 1 2 3)) nil)
|
|
(test (constp "foo") t)
|
|
(test (constp (mkstr 3)) nil)
|
|
(test (constp #(f o o)) t)
|
|
(test (constp (mkvec 3)) nil)
|
|
|
|
(test (charp nil) nil)
|
|
(test (charp #\c) t)
|
|
(test (charp 1) nil)
|
|
(test (charp '(pair)) nil)
|
|
(test (charp (lambda () nil)) nil)
|
|
(test (charp "string") nil)
|
|
(test (charp 'symbol) nil)
|
|
(test (charp #(vector)) nil)
|
|
(test (charp (inport)) nil)
|
|
(test (charp (outport)) nil)
|
|
(test (charp (catch (lambda (x) x))) nil)
|
|
|
|
(test (ctagp nil) nil)
|
|
(test (ctagp #\c) nil)
|
|
(test (ctagp 1) nil)
|
|
(test (ctagp '(pair)) nil)
|
|
(test (ctagp (lambda () nil)) nil)
|
|
(test (ctagp "string") nil)
|
|
(test (ctagp 'symbol) nil)
|
|
(test (ctagp #(vector)) nil)
|
|
(test (ctagp (inport)) nil)
|
|
(test (ctagp (outport)) nil)
|
|
(test (ctagp (catch (lambda (x) x))) t)
|
|
|
|
(test (eofp nil) nil)
|
|
(test (eofp #\c) nil)
|
|
(test (eofp 1) nil)
|
|
(test (eofp '(pair)) nil)
|
|
(test (eofp (lambda () nil)) nil)
|
|
(test (eofp "string") nil)
|
|
(test (eofp 'symbol) nil)
|
|
(test (eofp #(vector)) nil)
|
|
(test (eofp (inport)) nil)
|
|
(test (eofp (outport)) nil)
|
|
(test (eofp (catch (lambda (x) x))) nil)
|
|
|
|
(test (inportp nil) nil)
|
|
(test (inportp #\c) nil)
|
|
(test (inportp 1) nil)
|
|
(test (inportp '(pair)) nil)
|
|
(test (inportp (lambda () nil)) nil)
|
|
(test (inportp "string") nil)
|
|
(test (inportp 'symbol) nil)
|
|
(test (inportp #(vector)) nil)
|
|
(test (inportp (inport)) t)
|
|
(test (inportp (outport)) nil)
|
|
(test (inportp (catch (lambda (x) x))) nil)
|
|
|
|
(test (fixp nil) nil)
|
|
(test (fixp #\c) nil)
|
|
(test (fixp 1) t)
|
|
(test (fixp '(pair)) nil)
|
|
(test (fixp (lambda () nil)) nil)
|
|
(test (fixp "string") nil)
|
|
(test (fixp 'symbol) nil)
|
|
(test (fixp #(vector)) nil)
|
|
(test (fixp (inport)) nil)
|
|
(test (fixp (outport)) nil)
|
|
(test (fixp (catch (lambda (x) x))) nil)
|
|
|
|
(test (outportp nil) nil)
|
|
(test (outportp #\c) nil)
|
|
(test (outportp 1) nil)
|
|
(test (outportp '(pair)) nil)
|
|
(test (outportp (lambda () nil)) nil)
|
|
(test (outportp "string") nil)
|
|
(test (outportp 'symbol) nil)
|
|
(test (outportp #(vector)) nil)
|
|
(test (outportp (inport)) nil)
|
|
(test (outportp (outport)) t)
|
|
(test (outportp (catch (lambda (x) x))) nil)
|
|
|
|
(test (pair nil) nil)
|
|
(test (pair #\c) nil)
|
|
(test (pair 1) nil)
|
|
(test (pair '(pair)) t)
|
|
(test (pair (lambda () nil)) nil)
|
|
(test (pair "string") nil)
|
|
(test (pair 'symbol) nil)
|
|
(test (pair #(vector)) nil)
|
|
(test (pair (inport)) nil)
|
|
(test (pair (outport)) nil)
|
|
(test (pair (catch (lambda (x) x))) nil)
|
|
|
|
(test (funp nil) nil)
|
|
(test (funp #\c) nil)
|
|
(test (funp 1) nil)
|
|
(test (funp '(procedure)) nil)
|
|
(test (funp (lambda () nil)) t)
|
|
(test (funp "string") nil)
|
|
(test (funp 'symbol) nil)
|
|
(test (funp #(vector)) nil)
|
|
(test (funp (inport)) nil)
|
|
(test (funp (outport)) nil)
|
|
(test (funp (catch (lambda (x) x))) nil)
|
|
(test (funp car) t)
|
|
(test (funp 'car) nil)
|
|
(test (funp (lambda (x) (* x x))) t)
|
|
(test (funp '(lambda (x) (* x x))) nil)
|
|
|
|
(test (stringp nil) nil)
|
|
(test (stringp #\c) nil)
|
|
(test (stringp 1) nil)
|
|
(test (stringp '(pair)) nil)
|
|
(test (stringp (lambda () nil)) nil)
|
|
(test (stringp "string") t)
|
|
(test (stringp 'symbol) nil)
|
|
(test (stringp #(vector)) nil)
|
|
(test (stringp (inport)) nil)
|
|
(test (stringp (outport)) nil)
|
|
(test (stringp (catch (lambda (x) x))) nil)
|
|
|
|
(test (symbolp nil) nil)
|
|
(test (symbolp #\c) nil)
|
|
(test (symbolp 1) nil)
|
|
(test (symbolp '(pair)) nil)
|
|
(test (symbolp (lambda () nil)) nil)
|
|
(test (symbolp "string") nil)
|
|
(test (symbolp 'symbol) t)
|
|
(test (symbolp #(vector)) nil)
|
|
(test (symbolp (inport)) nil)
|
|
(test (symbolp (outport)) nil)
|
|
(test (symbolp (catch (lambda (x) x))) nil)
|
|
|
|
(test (vectorp nil) nil)
|
|
(test (vectorp #\c) nil)
|
|
(test (vectorp 1) nil)
|
|
(test (vectorp '(pair)) nil)
|
|
(test (vectorp (lambda () nil)) nil)
|
|
(test (vectorp "string") nil)
|
|
(test (vectorp 'symbol) nil)
|
|
(test (vectorp #(vector)) t)
|
|
(test (vectorp (inport)) nil)
|
|
(test (vectorp (outport)) nil)
|
|
(test (vectorp (catch (lambda (x) x))) nil)
|
|
|
|
;; Type Conversion
|
|
|
|
(test (charval #\A) 65)
|
|
(test (charval #\z) 122)
|
|
(test (charval #\nl) 10)
|
|
(test (charval #\sp) 32)
|
|
|
|
(test (char 65) #\A)
|
|
(test (char 122) #\z)
|
|
(test (char 10) #\nl)
|
|
(test (char 32) #\sp)
|
|
|
|
(test (liststr '(#\S #\t #\r #\i #\n #\g)) "String")
|
|
(test (liststr nil) "")
|
|
|
|
(test (listvec '(t foo 1 #\c "s" (1 2 3) #(u v)))
|
|
#(t foo 1 #\c "s" (1 2 3) #(u v)))
|
|
(test (listvec nil) #())
|
|
|
|
(test (strlist "String") '(#\S #\t #\r #\i #\n #\g))
|
|
(test (strlist "") nil)
|
|
|
|
(test (symbol "foo") 'foo)
|
|
(test (symbol "string->symbol") 'string->symbol)
|
|
|
|
(test (symname 'foo) "foo")
|
|
(test (symname 'a-b-c) "a-b-c")
|
|
(test (symname (symbol "miSSissiPPi")) "miSSissiPPi")
|
|
(test (symname 'Martin) "martin")
|
|
(test (eq 'bitBlt (symbol "bitBlt")) nil)
|
|
(test (eq 'JollyWog (symbol (symname 'JollyWog))) t)
|
|
(test (s= "K. Harper, M.D."
|
|
(symname(symbol "K. Harper, M.D.")))
|
|
t)
|
|
|
|
(test (eq (symbol "foo") 'foo) t)
|
|
|
|
(test (veclist #(t foo 1 #\c "s" (1 2 3) #(u v)))
|
|
'(t foo 1 #\c "s" (1 2 3) #(u v)))
|
|
(test (veclist #()) nil)
|
|
|
|
;; Function Application
|
|
|
|
(test (apply (lambda () 1) nil) 1)
|
|
(test (apply car '((a . b))) 'a)
|
|
(test (apply cdr '((a . b))) 'b)
|
|
(test (apply cons '(1 2)) '(1 . 2))
|
|
(test (apply list '(1 2 3)) '(1 2 3))
|
|
(test (apply list 1 '(2 3)) '(1 2 3))
|
|
(test (apply list 1 2 '(3)) '(1 2 3))
|
|
(test (apply list 1 2 3 nil) '(1 2 3))
|
|
(test (apply + (list 3 4)) 7)
|
|
|
|
;; Non-Local Exits
|
|
|
|
(test (catch* (lambda (k) 'foo)) 'foo)
|
|
|
|
(test (cons 'foo (catch* (lambda (ct) (throw* ct 'bar)))) '(foo . bar))
|
|
|
|
(test (cons 'foo (catch* (lambda (ct) (cons 'zzz (throw* ct 'bar)))))
|
|
'(foo . bar))
|
|
|
|
(test (catch (lambda (k) 'foo)) 'foo)
|
|
|
|
(test (cons 'foo (catch (lambda (ct) (throw ct 'bar)))) '(foo . bar))
|
|
|
|
(test (cons 'foo (catch (lambda (ct) (cons 'zzz (throw ct 'bar)))))
|
|
'(foo . bar))
|
|
|
|
(test (catch
|
|
(lambda (exit)
|
|
(foreach (lambda (x)
|
|
(if (< x 0)
|
|
(throw exit x)))
|
|
'(54 0 37 -3 245 19))
|
|
t))
|
|
-3)
|
|
|
|
(def list-length
|
|
(lambda (obj)
|
|
(catch
|
|
(lambda (return)
|
|
(labels ((r (lambda (obj)
|
|
(cond ((null obj)
|
|
0)
|
|
((pair obj)
|
|
(+ (r (cdr obj)) 1))
|
|
(else
|
|
(throw return nil))))))
|
|
(r obj))))))
|
|
|
|
(test (list-length '(1 2 3 4)) 4)
|
|
(test (list-length '(a b . c)) nil)
|
|
|
|
(test (catch-errors ('caught) (error "catch me!")) 'caught)
|
|
(test (catch-errors (0) (div 1 0)) 0)
|
|
|
|
(test (let ((foo 'initial))
|
|
(unwind
|
|
(lambda ()
|
|
(setq foo 'unwound))
|
|
(lambda ()
|
|
(setq foo 'wrong)))
|
|
foo)
|
|
'unwound)
|
|
|
|
(test (let ((foo 'initial))
|
|
(catch
|
|
(lambda (c)
|
|
(setq foo 'modified)))
|
|
foo)
|
|
'modified)
|
|
|
|
(test (let ((foo 'initial))
|
|
(catch
|
|
(lambda (c)
|
|
(unwind
|
|
(lambda ()
|
|
(setq foo 'unwound))
|
|
(lambda ()
|
|
(setq foo 'wrong)))))
|
|
foo)
|
|
'unwound)
|
|
|
|
(test (let ((foo 'initial))
|
|
(catch
|
|
(lambda (c)
|
|
(unwind
|
|
(lambda ()
|
|
(setq foo 'unwound))
|
|
(lambda ()
|
|
(setq foo 'modified)
|
|
(throw c 'ignore)
|
|
(setq foo 'wrong)))))
|
|
foo)
|
|
'unwound)
|
|
|
|
(test (let ((foo '(initial)))
|
|
(catch
|
|
(lambda (c)
|
|
(unwind
|
|
(lambda ()
|
|
(setq foo (cons 'also-unwound foo)))
|
|
(lambda ()
|
|
(catch
|
|
(lambda (k)
|
|
(unwind
|
|
(lambda ()
|
|
(setq foo (cons 'unwound foo)))
|
|
(lambda ()
|
|
(setq foo '(modified))
|
|
(throw c 'ignore)
|
|
(setq foo '(wrong))))))))))
|
|
foo)
|
|
'(also-unwound unwound modified))
|
|
|
|
(def *parameter* 'default)
|
|
|
|
(test (let ((outer-parameter *parameter*))
|
|
(catch
|
|
(lambda (foo)
|
|
(unwind (lambda ()
|
|
(setq *parameter* outer-parameter))
|
|
(lambda ()
|
|
(setq *parameter* 'modified)
|
|
(throw foo 'ignore)
|
|
(setq *parameter* 'original)))))
|
|
*parameter*)
|
|
'default)
|
|
|
|
(def *parameter* 'default)
|
|
|
|
(test (prog (catch
|
|
(lambda (foo)
|
|
(with ((*parameter* 'modified))
|
|
(throw foo 'ignore))))
|
|
*parameter*)
|
|
'default)
|
|
|
|
;; Higher Order Functions
|
|
|
|
(test (fold cons 0 '(a b c)) '(((0 . a) . b) . c))
|
|
(test (fold + 5 '(1 2 3 4)) 15)
|
|
(test (foldr cons 0 '(a b c)) '(a b c . 0))
|
|
(test (foldr - 5 '(1 2 3 4)) 3)
|
|
|
|
(test (let ((a (list (list 'a) (list 'b) (list 'c))))
|
|
(foreach (lambda (x) (setcar x 'x)) a)
|
|
a)
|
|
'((x) (x) (x)))
|
|
(test (let ((a (list (list 'a) (list 'b) (list 'c))))
|
|
(foreach (lambda (x y) (setcar x y)) a '(x y z))
|
|
a)
|
|
'((x) (y) (z)))
|
|
|
|
(test (mapcar - '(1 2 3)) '(-1 -2 -3))
|
|
(test (mapcar cons '(1 2 3) '(a b c))
|
|
'((1 . a) (2 . b) (3 . c)))
|
|
(test (mapcar list '(1 2 3) '(a b c) '(#\x #\y #\z))
|
|
'((1 a #\x) (2 b #\y) (3 c #\z)))
|
|
|
|
(test (mapcar cadr '((a b) (d e) (g h))) '(b e h))
|
|
(test (mapcar + '(1 2 3) '(4 5 6)) '(5 7 9))
|
|
|
|
(test (mapcar (lambda (n) (expt n n)) '(1 2 3 4 5))
|
|
'(1 4 27 256 3125))
|
|
|
|
;; Lists
|
|
|
|
(test (atom t) t)
|
|
(test (atom #\c) t)
|
|
(test (atom 1) t)
|
|
(test (atom '(atom)) nil)
|
|
(test (atom (lambda () t)) t)
|
|
(test (atom "string") t)
|
|
(test (atom 'symbol) t)
|
|
(test (atom #(vector)) t)
|
|
(test (atom (inport)) t)
|
|
(test (atom (outport)) t)
|
|
(test (atom (catch (lambda (x) x))) t)
|
|
|
|
(test (conc nil '(a b c)) '(a b c))
|
|
(test (conc '(a b c) nil) '(a b c))
|
|
(test (conc nil nil) nil)
|
|
(test (conc) nil)
|
|
(test (conc '(a b)) '(a b))
|
|
(test (conc '(a b) '(c d)) '(a b c d))
|
|
(test (conc '(a b) '(c d) '(e f)) '(a b c d e f))
|
|
(test (conc '(a b) 'c) '(a b . c))
|
|
(test (conc '(a) 'b) '(a . b))
|
|
(test (conc 'a) 'a)
|
|
(test (conc '(a (b)) '((c))) '(a (b) (c)))
|
|
(test (conc '(a b) '(c . d)) '(a b c . d))
|
|
(test (conc nil 'a) 'a)
|
|
|
|
(test (nconc nil (list 1 2 3)) '(1 2 3))
|
|
(test (nconc (list 1 2 3) nil) '(1 2 3))
|
|
(test (nconc nil nil) nil)
|
|
(test (nconc) nil)
|
|
(test (nconc (list 1 2)) '(1 2))
|
|
(test (nconc (list 1 2) (list 3 4)) '(1 2 3 4))
|
|
(test (nconc (list 1 2) (list 3 4) (list 5 6)) '(1 2 3 4 5 6))
|
|
(test (nconc (list 1 2) 3) '(1 2 . 3))
|
|
(test (nconc (list 1) 2) '(1 . 2))
|
|
(test (nconc 1) 1)
|
|
(test (nconc (list 1 '(2)) (list '(3))) '(1 (2) (3)))
|
|
(test (nconc (list 1 2) (cons 3 4)) '(1 2 3 . 4))
|
|
(test (nconc nil 1) 1)
|
|
|
|
(test (assoc 'c '((a . a) (b . b))) nil)
|
|
(test (assoc 'b '((a . a) (b . b))) '(b . b))
|
|
(test (assoc 'a '((a . a) (b . b))) '(a . a))
|
|
(test (assoc 'x nil) nil)
|
|
(test (assoc '(x) '(((x) . x))) '((x) . x))
|
|
(test (assoc "x" '(("x" . x))) '("x" . x))
|
|
(test (assoc 1 '((1 . x))) '(1 . x))
|
|
(test (assoc #\x '((#\x . x))) '(#\x . x))
|
|
(test (assoc (list 'a) '(((a)) ((b)) ((c)))) '((a)))
|
|
|
|
(test (assv 'c '((a . a) (b . b))) nil)
|
|
(test (assv 'b '((a . a) (b . b))) '(b . b))
|
|
(test (assv 'a '((a . a) (b . b))) '(a . a))
|
|
(test (assv 'x nil) nil)
|
|
(test (assv '(x) '(((x) . x))) nil)
|
|
(test (assv "x" '(("x" . x))) nil)
|
|
(test (assv 1 '((1 . x))) '(1 . x))
|
|
(test (assv #\x '((#\x . x))) '(#\x . x))
|
|
(test (assv 5 '((2 3) (5 7) (11 13))) '(5 7))
|
|
|
|
(test (assq 'c '((a . a) (b . b))) nil)
|
|
(test (assq 'b '((a . a) (b . b))) '(b . b))
|
|
(test (assq 'a '((a . a) (b . b))) '(a . a))
|
|
(test (assq 'x nil) nil)
|
|
(test (assq '(x) '(((x) . x))) nil)
|
|
(test (assq "x" '(("x" . x))) nil)
|
|
|
|
(def e '((a 1) (b 2) (c 3)))
|
|
(test (assq 'a e) '(a 1))
|
|
(test (assq 'b e) '(b 2))
|
|
(test (assq 'd e) nil)
|
|
(test (assq (list 'a) '(((a)) ((b)) ((c)))) nil)
|
|
|
|
(def tree '((((1 . 2) . (3 . 4)) . ((5 . 6) . (7 . 8)))
|
|
.
|
|
(((9 . 10) . (11 . 12)) . ((13 . 14) . (15 . 16)))))
|
|
(test (caar tree) '((1 . 2) . (3 . 4)))
|
|
(test (cadr tree) '((9 . 10) . (11 . 12)))
|
|
(test (cdar tree) '((5 . 6) . (7 . 8)))
|
|
(test (cddr tree) '((13 . 14) . (15 . 16)))
|
|
(test (caaar tree) '(1 . 2))
|
|
(test (caadr tree) '(9 . 10))
|
|
(test (cadar tree) '(5 . 6))
|
|
(test (caddr tree) '(13 . 14))
|
|
(test (cdaar tree) '(3 . 4))
|
|
(test (cdadr tree) '(11 . 12))
|
|
(test (cddar tree) '(7 . 8))
|
|
(test (cdddr tree) '(15 . 16))
|
|
(test (caaaar tree) 1)
|
|
(test (caaadr tree) 9)
|
|
(test (caadar tree) 5)
|
|
(test (caaddr tree) 13)
|
|
(test (cadaar tree) 3)
|
|
(test (cadadr tree) 11)
|
|
(test (caddar tree) 7)
|
|
(test (cadddr tree) 15)
|
|
(test (cdaaar tree) 2)
|
|
(test (cdaadr tree) 10)
|
|
(test (cdadar tree) 6)
|
|
(test (cdaddr tree) 14)
|
|
(test (cddaar tree) 4)
|
|
(test (cddadr tree) 12)
|
|
(test (cdddar tree) 8)
|
|
(test (cddddr tree) 16)
|
|
|
|
(test (cons 1 2) '(1 . 2))
|
|
(test (cons 1 '(2)) '(1 2))
|
|
(test (cons 1 (cons 2 nil)) '(1 2))
|
|
(test (cons 'a nil) '(a))
|
|
(test (cons '(a) '(b c d)) '((a) b c d))
|
|
(test (cons "a" '(b c)) '("a" b c))
|
|
(test (cons 'a 3) '(a . 3))
|
|
(test (cons '(a b) 'c) '((a b) . c))
|
|
|
|
(test (car '(1 1)) 1)
|
|
(test (car '(1 . 2)) 1)
|
|
(test (car '(a b c)) 'a)
|
|
(test (car '((a) b c d)) '(a))
|
|
|
|
(test (cdr '((a) b c d)) '(b c d))
|
|
(test (cdr '(1 . 2)) 2)
|
|
(test (cdr '(1 2)) '(2))
|
|
|
|
(test (length nil) 0)
|
|
(test (length '(1)) 1)
|
|
(test (length '(1 2 3)) 3)
|
|
(test (length '(a (b) (c d e))) 3)
|
|
|
|
(test (list) nil)
|
|
(test (list nil) '(()))
|
|
(test (list 'x) '(x))
|
|
(test (list (list 'x)) '((x)))
|
|
(test (list 'a 'b) '(a b))
|
|
(test (list 'a 'b 'c) '(a b c))
|
|
(test (list 'a 'b 'c 'd) '(a b c d))
|
|
(test (list 'a 'b 'c 'd 'e) '(a b c d e))
|
|
(test (list 'a (+ 3 4) 'c) '(a 7 c))
|
|
|
|
(test (nth 0 '(1 2 3)) 1)
|
|
(test (nth 1 '(1 2 3)) 2)
|
|
(test (nth 2 '(1 2 3)) 3)
|
|
|
|
(test (nth-tail 0 '(1 2 3)) '(1 2 3))
|
|
(test (nth-tail 1 '(1 2 3)) '(2 3))
|
|
(test (nth-tail 2 '(1 2 3)) '(3))
|
|
(test (nth-tail 3 '(1 2 3)) '())
|
|
|
|
(test (listp nil) t)
|
|
(test (listp #\c) nil)
|
|
(test (listp 1) nil)
|
|
(test (listp '(pair)) t)
|
|
(test (listp (lambda () nil)) nil)
|
|
(test (listp "string") nil)
|
|
(test (listp 'symbol) nil)
|
|
(test (listp #(vector)) nil)
|
|
(test (listp (inport)) nil)
|
|
(test (listp (outport)) nil)
|
|
(test (listp (catch (lambda (x) x))) nil)
|
|
(test (listp nil) t)
|
|
(test (listp '(1)) t)
|
|
(test (listp '(1 . ())) t)
|
|
(test (listp '(1 2 3)) t)
|
|
(test (listp '(1 . 2)) nil)
|
|
(test (listp '(1 2 . 3)) nil)
|
|
|
|
(let ((cyclic2 (list 1 2))
|
|
(cyclic3 (list 1 2 3)))
|
|
(setcdr (cdr cyclic2) cyclic2)
|
|
(setcdr (cddr cyclic3) cyclic3)
|
|
(if (listp cyclic2)
|
|
(fail '(listp 'cyclic2) t)
|
|
(test (listp 'cyclic2) nil))
|
|
(if (listp cyclic3)
|
|
(fail '(listp 'cyclic3) t)
|
|
(test (listp 'cyclic3) nil)))
|
|
|
|
(test (member 'c '(a b)) nil)
|
|
(test (member 'b '(a b)) '(b))
|
|
(test (member 'a '(a b)) '(a b))
|
|
(test (member 'x nil) nil)
|
|
(test (member '(x) '((x))) '((x)))
|
|
(test (member "x" '("x")) '("x"))
|
|
(test (member 1 '(1)) '(1))
|
|
(test (member #\x '(#\x)) '(#\x))
|
|
(test (member (list 'a) '(b (a) c)) '((a) c))
|
|
|
|
(test (memv 'c '(a b)) nil)
|
|
(test (memv 'b '(a b)) '(b))
|
|
(test (memv 'a '(a b)) '(a b))
|
|
(test (memv 'x nil) nil)
|
|
(test (memv '(x) '((x))) nil)
|
|
(test (memv "x" '("x")) nil)
|
|
(test (memv 1 '(1)) '(1))
|
|
(test (memv #\x '(#\x)) '(#\x))
|
|
(test (memv 101 '(100 101 102)) '(101 102))
|
|
|
|
(test (memq 'c '(a b)) nil)
|
|
(test (memq 'b '(a b)) '(b))
|
|
(test (memq 'a '(a b)) '(a b))
|
|
(test (memq 'x nil) nil)
|
|
(test (memq '(x) '((x))) nil)
|
|
(test (memq "x" '("x")) nil)
|
|
(test (memq (list 'a) '(b (a) c)) nil)
|
|
|
|
(test (null nil) t)
|
|
(test (null #\c) nil)
|
|
(test (null 1) nil)
|
|
(test (null '(pair)) nil)
|
|
(test (null (lambda () nil)) nil)
|
|
(test (null "string") nil)
|
|
(test (null 'symbol) nil)
|
|
(test (null #(vector)) nil)
|
|
(test (null (inport)) nil)
|
|
(test (null (outport)) nil)
|
|
(test (null nil) t)
|
|
|
|
(test (reconc nil '(1 2 3)) '(1 2 3))
|
|
(test (reconc '(4 1 3) '(1 5 9)) '(3 1 4 1 5 9))
|
|
(test (reconc '(3 2 1) 4) '(1 2 3 . 4))
|
|
|
|
(test (reconc nil '(1 2 3)) '(1 2 3))
|
|
(test (reconc (list 4 1 3) '(1 5 9)) '(3 1 4 1 5 9))
|
|
(test (reconc (list 3 2 1) 4) '(1 2 3 . 4))
|
|
|
|
(test (rever '(1)) '(1))
|
|
(test (rever '(1 2 3)) '(3 2 1))
|
|
(test (rever nil) nil)
|
|
(test (rever '(a (b c) d (e (f)))) '((e (f)) d (b c) a))
|
|
|
|
(test (nrever (list 1 2 3)) '(3 2 1))
|
|
(test (nrever nil) nil)
|
|
|
|
;; Arithmetics
|
|
|
|
(test (+ 1234 987) 2221)
|
|
(test (+ 1234 -987) 247)
|
|
(test (+ -1234 987) -247)
|
|
(test (+ -1234 -987) -2221)
|
|
(test (+ 987 1234) 2221)
|
|
(test (+ 987 -1234) -247)
|
|
(test (+ -987 1234) 247)
|
|
(test (+ -987 -1234) -2221)
|
|
(test (+ 1234 0) 1234)
|
|
(test (+ 0 1234) 1234)
|
|
(test (+ 1 2 3 4 5 6 7 8 9 10) 55)
|
|
(test (+ 1) 1)
|
|
(test (+) 0)
|
|
|
|
(test (- 1234 987) 247)
|
|
(test (- 1234 -987) 2221)
|
|
(test (- -1234 987) -2221)
|
|
(test (- -1234 -987) -247)
|
|
(test (- 987 1234) -247)
|
|
(test (- 987 -1234) 2221)
|
|
(test (- -987 1234) -2221)
|
|
(test (- -987 -1234) 247)
|
|
(test (- 1234 0) 1234)
|
|
(test (- 0 1234) -1234)
|
|
(test (- 1 2 3 4 5 6 7 8 9 10) -53)
|
|
(test (- 1234) -1234)
|
|
(test (- 0) 0)
|
|
|
|
(test (* 123 54) 6642)
|
|
(test (* 123 -54) -6642)
|
|
(test (* -123 54) -6642)
|
|
(test (* -123 -54) 6642)
|
|
(test (* 54 123) 6642)
|
|
(test (* 54 -123) -6642)
|
|
(test (* -54 123) -6642)
|
|
(test (* -54 -123) 6642)
|
|
(test (* 123 1) 123)
|
|
(test (* 1 123) 123)
|
|
(test (* 123 0) 0)
|
|
(test (* 0 123) 0)
|
|
(test (* 1 2 3 4 5) 120)
|
|
(test (* 2) 2)
|
|
(test (*) 1)
|
|
|
|
(test (< 123 987) t)
|
|
(test (< 123 -987) nil)
|
|
(test (< -123 987) t)
|
|
(test (< -123 -987) nil)
|
|
(test (< 987 123) nil)
|
|
(test (< 987 -123) nil)
|
|
(test (< -987 123) t)
|
|
(test (< -987 -123) t)
|
|
(test (< -123 -123) nil)
|
|
(test (< 123 123) nil)
|
|
(test (< 123 0) nil)
|
|
(test (< 0 123) t)
|
|
(test (< 1 2 3 4 5 6 7 8 9 10) t)
|
|
(test (< 1 2 3 4 5 6 7 8 9 9) nil)
|
|
|
|
(test (<= 123 987) t)
|
|
(test (<= 123 -987) nil)
|
|
(test (<= -123 987) t)
|
|
(test (<= -123 -987) nil)
|
|
(test (<= 987 123) nil)
|
|
(test (<= 987 -123) nil)
|
|
(test (<= -987 123) t)
|
|
(test (<= -987 -123) t)
|
|
(test (<= -123 -123) t)
|
|
(test (<= 123 123) t)
|
|
(test (<= 123 0) nil)
|
|
(test (<= 0 123) t)
|
|
(test (<= 1 2 3 4 5 6 7 8 9 10) t)
|
|
(test (<= 1 2 3 4 5 6 7 8 9 9) t)
|
|
|
|
(test (= 123 987) nil)
|
|
(test (= 123 -987) nil)
|
|
(test (= -123 987) nil)
|
|
(test (= -123 -987) nil)
|
|
(test (= 987 123) nil)
|
|
(test (= 987 -123) nil)
|
|
(test (= -987 123) nil)
|
|
(test (= -987 -123) nil)
|
|
(test (= -123 123) nil)
|
|
(test (= 123 -123) nil)
|
|
(test (= 123 123) t)
|
|
(test (= -123 -123) t)
|
|
(test (= 0 0) t)
|
|
(test (= 0 123) nil)
|
|
(test (= 123 0) nil)
|
|
(test (= 1 1 1 1 1 1 1 1 1 1) t)
|
|
(test (= 1 1 1 1 1 1 1 1 1 0) nil)
|
|
|
|
(test (> 123 987) nil)
|
|
(test (> 123 -987) t)
|
|
(test (> -123 987) nil)
|
|
(test (> -123 -987) t)
|
|
(test (> 987 123) t)
|
|
(test (> 987 -123) t)
|
|
(test (> -987 123) nil)
|
|
(test (> -987 -123) nil)
|
|
(test (> -123 -123) nil)
|
|
(test (> 123 123) nil)
|
|
(test (> 123 0) t)
|
|
(test (> 0 123) nil)
|
|
(test (> 9 8 7 6 5 4 3 2 1 0) t)
|
|
(test (> 9 8 7 6 5 4 3 2 1 1) nil)
|
|
|
|
(test (>= 123 987) nil)
|
|
(test (>= 123 -987) t)
|
|
(test (>= -123 987) nil)
|
|
(test (>= -123 -987) t)
|
|
(test (>= 987 123) t)
|
|
(test (>= 987 -123) t)
|
|
(test (>= -987 123) nil)
|
|
(test (>= -987 -123) nil)
|
|
(test (>= -123 -123) t)
|
|
(test (>= 123 123) t)
|
|
(test (>= 123 0) t)
|
|
(test (>= 0 123) nil)
|
|
(test (>= 9 8 7 6 5 4 3 2 1 0) t)
|
|
(test (>= 9 8 7 6 5 4 3 2 1 1) t)
|
|
|
|
(test (abs 0) 0)
|
|
(test (abs 123) 123)
|
|
(test (abs -123) 123)
|
|
|
|
(defun (mask x) (bitop 1 #2r1111 x))
|
|
|
|
(test (mask (bitop 0 #2r0011 #2r0101)) 0)
|
|
(test (mask (bitop 1 #2r0011 #2r0101)) 1)
|
|
(test (mask (bitop 2 #2r0011 #2r0101)) 2)
|
|
(test (mask (bitop 3 #2r0011 #2r0101)) 3)
|
|
(test (mask (bitop 4 #2r0011 #2r0101)) 4)
|
|
(test (mask (bitop 5 #2r0011 #2r0101)) 5)
|
|
(test (mask (bitop 6 #2r0011 #2r0101)) 6)
|
|
(test (mask (bitop 7 #2r0011 #2r0101)) 7)
|
|
(test (mask (bitop 8 #2r0011 #2r0101)) 8)
|
|
(test (mask (bitop 9 #2r0011 #2r0101)) 9)
|
|
(test (mask (bitop 10 #2r0011 #2r0101)) 10)
|
|
(test (mask (bitop 11 #2r0011 #2r0101)) 11)
|
|
(test (mask (bitop 12 #2r0011 #2r0101)) 12)
|
|
(test (mask (bitop 13 #2r0011 #2r0101)) 13)
|
|
(test (mask (bitop 14 #2r0011 #2r0101)) 14)
|
|
(test (mask (bitop 15 #2r0011 #2r0101)) 15)
|
|
|
|
(test (bitop 16 2 3) 16)
|
|
(test (bitop 17 16 3) 2)
|
|
|
|
(test (evenp 0) t)
|
|
(test (evenp 1) nil)
|
|
(test (evenp 2) t)
|
|
|
|
(test (expt 2 0) 1)
|
|
(test (expt 2 1) 2)
|
|
(test (expt 2 2) 4)
|
|
(test (expt -3 3) -27)
|
|
|
|
(test (oddp 0) nil)
|
|
(test (oddp 1) t)
|
|
(test (oddp 2) nil)
|
|
|
|
(test (gcd 18 12) 6)
|
|
(test (gcd 32 -36) 4)
|
|
|
|
(test (lcm 12 18) 36)
|
|
(test (lcm 32 -36) 288)
|
|
|
|
(test (max 1) 1)
|
|
(test (max 1 2) 2)
|
|
(test (max 5 7 3 1 6 9 8 2 0 4) 9)
|
|
(test (max -1 0 1) 1)
|
|
|
|
(test (min 1) 1)
|
|
(test (min 1 2) 1)
|
|
(test (min 5 7 3 1 6 9 8 2 0 4) 0)
|
|
(test (min -1 0 1) -1)
|
|
|
|
(test (mod 123 1234) 123)
|
|
(test (mod 123 -1234) -1111)
|
|
(test (mod -123 1234) 1111)
|
|
(test (mod -123 -1234) -123)
|
|
(test (mod 1234 123) 4)
|
|
(test (mod 1234 -123) -119)
|
|
(test (mod -1234 123) 119)
|
|
(test (mod -1234 -123) -4)
|
|
(test (mod 1234 123) 4)
|
|
(test (mod 1234 -123) -119)
|
|
(test (mod -1234 123) 119)
|
|
(test (mod -1234 -123) -4)
|
|
|
|
(test (mod 13 4) 1)
|
|
(test (rem 13 4) 1)
|
|
(test (mod -13 4) 3)
|
|
(test (rem -13 4) -1)
|
|
(test (mod 13 -4) -3)
|
|
(test (rem 13 -4) 1)
|
|
(test (mod -13 -4) -1)
|
|
(test (rem -13 -4) -1)
|
|
|
|
(test (not t) nil)
|
|
(test (not nil) t)
|
|
(test (not '()) t)
|
|
(test (not #\c) nil)
|
|
(test (not 1) nil)
|
|
(test (not '(pair)) nil)
|
|
(test (not (lambda () nil)) nil)
|
|
(test (not "string") nil)
|
|
(test (not 'symbol) nil)
|
|
(test (not #(vector)) nil)
|
|
(test (not (inport)) nil)
|
|
(test (not (outport)) nil)
|
|
(test (not (catch (lambda (x) x))) nil)
|
|
|
|
(test (div 123 1234) 0)
|
|
(test (div 123 -1234) 0)
|
|
(test (div -123 1234) 0)
|
|
(test (div -123 -1234) 0)
|
|
(test (div 1234 123) 10)
|
|
(test (div 1234 -123) -10)
|
|
(test (div -1234 123) -10)
|
|
(test (div -1234 -123) 10)
|
|
(test (div 1234 1234) 1)
|
|
(test (div 1234 -1234) -1)
|
|
(test (div -1234 1234) -1)
|
|
(test (div -1234 -1234) 1)
|
|
|
|
(test (rem 123 1234) 123)
|
|
(test (rem 123 -1234) 123)
|
|
(test (rem -123 1234) -123)
|
|
(test (rem -123 -1234) -123)
|
|
(test (rem 1234 123) 4)
|
|
(test (rem 1234 -123) 4)
|
|
(test (rem -1234 123) -4)
|
|
(test (rem -1234 -123) -4)
|
|
(test (rem 1234 1234) 0)
|
|
(test (rem 1234 -1234) 0)
|
|
(test (rem -1234 1234) 0)
|
|
(test (rem -1234 -1234) 0)
|
|
|
|
; Equivalence
|
|
|
|
(test (eq 'x 'x) t)
|
|
(test (eq eq eq) t)
|
|
(test (eq nil nil) t)
|
|
(test (eq 'x 'y) nil)
|
|
(test (eq 'x '(x . y)) nil)
|
|
(test ((lambda (x) (eq x x)) '(x . y)) t)
|
|
(test (eq t t) t)
|
|
(test (eq nil nil) t)
|
|
(test (eq (list 'pair) (list 'pair)) nil)
|
|
(test (eq (lambda () nil) (lambda () nil)) nil)
|
|
(test (eq 'symbol 'symbol) t)
|
|
(test (eq (vector 'vector) (vector 'vector)) nil)
|
|
|
|
(test (eq car car) t)
|
|
(test (let ((x '(a))) (eq x x)) t)
|
|
(test (let ((x #())) (eq x x)) t)
|
|
(test (let ((p (lambda (x) x))) (eq p p)) t)
|
|
|
|
(test (eqv nil nil) t)
|
|
(test (eqv #\c #\c) t)
|
|
(test (eqv 1 1) t)
|
|
(test (eqv (list 'pair) (list 'pair)) nil)
|
|
(test (eqv (lambda () nil) (lambda () nil)) nil)
|
|
(test (eqv 'symbol 'symbol) t)
|
|
(test (eqv (vector 'vector) (vector 'vector)) nil)
|
|
|
|
(test (eqv 'a 'a) t)
|
|
(test (eqv 'a 'b) nil)
|
|
(test (eqv 2 2) t)
|
|
(test (eqv nil nil) t)
|
|
(test (eqv 1000 1000) t)
|
|
(test (eqv (cons 1 2) (cons 1 2)) nil)
|
|
(test (eqv (lambda () 1) (lambda () 2)) nil)
|
|
(test (let ((p (lambda (x) x))) (eqv p p)) t)
|
|
|
|
(def gen-counter
|
|
(lambda ()
|
|
(let ((n 0))
|
|
(lambda () (setq n (+ n 1)) n))))
|
|
|
|
(test (let ((g (gen-counter))) (eqv g g)) t)
|
|
(test (eqv (gen-counter) (gen-counter)) nil)
|
|
|
|
(def gen-loser
|
|
(lambda ()
|
|
(let ((n 0))
|
|
(lambda () (setq n (+ n 1)) 27))))
|
|
|
|
(test (let ((g (gen-loser))) (eqv g g)) t)
|
|
|
|
(test (labels ((f (lambda () (if (eqv f g) 'f 'both)))
|
|
(g (lambda () (if (eqv f g) 'g 'both))))
|
|
(eqv (f) (g)))
|
|
t)
|
|
|
|
(test (let ((x '(a))) (eqv x x)) t)
|
|
|
|
(test (equal nil nil) t)
|
|
(test (equal #\c #\c) t)
|
|
(test (equal 1 1) t)
|
|
(test (equal '(pair) '(pair)) t)
|
|
(test (equal '(pair (1)) '(pair (2))) nil)
|
|
(test (equal (lambda () nil) (lambda () nil)) nil)
|
|
(test (equal "string" "string") t)
|
|
(test (equal 'symbol 'symbol) t)
|
|
(test (equal #(vector) #(vector)) t)
|
|
(test (equal #(vector (list) vector) #(vector (list) vector)) t)
|
|
(test (equal #(vector #(vector) vector) #(vector #(vector) vector)) t)
|
|
(test (equal #(vector #(vec1) vector) #(vector #(vec2) vector)) nil)
|
|
(test (equal tree tree) t)
|
|
|
|
(test (equal nil #\c) nil)
|
|
(test (equal nil 1) nil)
|
|
(test (equal nil '(pair)) nil)
|
|
(test (equal nil (lambda () nil)) nil)
|
|
(test (equal nil "string") nil)
|
|
(test (equal nil 'symbol) nil)
|
|
(test (equal nil #(vector)) nil)
|
|
(test (equal nil (inport)) nil)
|
|
(test (equal nil (outport)) nil)
|
|
(test (equal #\c 1) nil)
|
|
(test (equal #\c '(pair)) nil)
|
|
(test (equal #\c (lambda () nil)) nil)
|
|
(test (equal #\c "string") nil)
|
|
(test (equal #\c 'symbol) nil)
|
|
(test (equal #\c #(vector)) nil)
|
|
(test (equal #\c (inport)) nil)
|
|
(test (equal #\c (outport)) nil)
|
|
(test (equal 1 '(pair)) nil)
|
|
(test (equal 1 (lambda () nil)) nil)
|
|
(test (equal 1 "string") nil)
|
|
(test (equal 1 'symbol) nil)
|
|
(test (equal 1 #(vector)) nil)
|
|
(test (equal 1 (inport)) nil)
|
|
(test (equal 1 (outport)) nil)
|
|
(test (equal '(pair) (lambda () nil)) nil)
|
|
(test (equal '(pair) "string") nil)
|
|
(test (equal '(pair) 'symbol) nil)
|
|
(test (equal '(pair) #(vector)) nil)
|
|
(test (equal '(pair) (inport)) nil)
|
|
(test (equal '(pair) (outport)) nil)
|
|
(test (equal (lambda () nil) "string") nil)
|
|
(test (equal (lambda () nil) 'symbol) nil)
|
|
(test (equal (lambda () nil) #(vector)) nil)
|
|
(test (equal (lambda () nil) (inport)) nil)
|
|
(test (equal (lambda () nil) (outport)) nil)
|
|
(test (equal "string" 'symbol) nil)
|
|
(test (equal "string" #(vector)) nil)
|
|
(test (equal "string" (inport)) nil)
|
|
(test (equal "string" (outport)) nil)
|
|
(test (equal 'symbol #(vector)) nil)
|
|
(test (equal 'symbol (inport)) nil)
|
|
(test (equal 'symbol (outport)) nil)
|
|
(test (equal #(vector) (inport)) nil)
|
|
(test (equal #(vector) (outport)) nil)
|
|
(test (equal (inport) (outport)) nil)
|
|
|
|
(test (let ((x (list 1))) (equal x x)) t)
|
|
|
|
(test (equal '(a (b c) (d (e . f) g)) '(a (b c) (d (e . f) g))) t)
|
|
(test (equal '(a (b c) (d (e . x) g)) '(a (b c) (d (e . f) g))) nil)
|
|
(test (equal #(a (b c) (d (e . f) g)) #(a (b c) (d (e . f) g))) t)
|
|
(test (equal #(a (b c) (d (e . x) g)) #(a (b c) (d (e . f) g))) nil)
|
|
|
|
;; Chars
|
|
|
|
(test (alphac #\a) t)
|
|
(test (alphac #\A) t)
|
|
(test (alphac #\z) t)
|
|
(test (alphac #\Z) t)
|
|
(test (alphac #\@) nil)
|
|
(test (alphac #\[) nil)
|
|
(test (alphac #\`) nil)
|
|
(test (alphac #\{) nil)
|
|
|
|
(test (downcase #\a) #\a)
|
|
(test (downcase #\A) #\a)
|
|
(test (downcase #\z) #\z)
|
|
(test (downcase #\Z) #\z)
|
|
(test (downcase #\@) #\@)
|
|
(test (downcase #\[) #\[)
|
|
(test (downcase #\`) #\`)
|
|
(test (downcase #\{) #\{)
|
|
|
|
(test (lowerc #\a) t)
|
|
(test (lowerc #\A) nil)
|
|
(test (lowerc #\z) t)
|
|
(test (lowerc #\Z) nil)
|
|
(test (lowerc #\@) nil)
|
|
(test (lowerc #\[) nil)
|
|
(test (lowerc #\`) nil)
|
|
(test (lowerc #\{) nil)
|
|
|
|
(test (numeric #\0) t)
|
|
(test (numeric #\9) t)
|
|
(test (numeric #\/) nil)
|
|
(test (numeric #\:) nil)
|
|
|
|
(test (upcase #\a) #\A)
|
|
(test (upcase #\A) #\A)
|
|
(test (upcase #\z) #\Z)
|
|
(test (upcase #\Z) #\Z)
|
|
(test (upcase #\@) #\@)
|
|
(test (upcase #\[) #\[)
|
|
(test (upcase #\`) #\`)
|
|
(test (upcase #\{) #\{)
|
|
|
|
(test (upperc #\a) nil)
|
|
(test (upperc #\A) t)
|
|
(test (upperc #\z) nil)
|
|
(test (upperc #\Z) t)
|
|
(test (upperc #\@) nil)
|
|
(test (upperc #\[) nil)
|
|
(test (upperc #\`) nil)
|
|
(test (upperc #\{) nil)
|
|
|
|
(test (whitec #\0) nil)
|
|
(test (whitec #\9) nil)
|
|
(test (whitec #\a) nil)
|
|
(test (whitec #\z) nil)
|
|
(test (whitec #\ ) t)
|
|
(test (whitec #\sp) t)
|
|
(test (whitec #\nl) t)
|
|
(test (whitec (char 9)) t)
|
|
(test (whitec (char 10)) t)
|
|
(test (whitec (char 12)) t)
|
|
(test (whitec (char 13)) t)
|
|
|
|
(test (c< #\+ #\+) nil)
|
|
(test (c< #\+ #\-) t)
|
|
(test (c< #\A #\A) nil)
|
|
(test (c< #\A #\a) t)
|
|
(test (c< #\a #\A) nil)
|
|
(test (c< #\a #\a) nil)
|
|
(test (c< #\A #\Z) t)
|
|
(test (c< #\A #\z) t)
|
|
(test (c< #\a #\Z) nil)
|
|
(test (c< #\a #\z) t)
|
|
(test (c< #\Z #\A) nil)
|
|
(test (c< #\Z #\a) t)
|
|
(test (c< #\z #\A) nil)
|
|
(test (c< #\z #\a) nil)
|
|
(test (c< #\a #\b #\c) t)
|
|
(test (c< #\a #\a #\b) nil)
|
|
(test (c< #\c #\c #\b) nil)
|
|
(test (c< #\c #\b #\a) nil)
|
|
|
|
(test (c<= #\+ #\+) t)
|
|
(test (c<= #\+ #\-) t)
|
|
(test (c<= #\A #\A) t)
|
|
(test (c<= #\A #\a) t)
|
|
(test (c<= #\a #\A) nil)
|
|
(test (c<= #\a #\a) t)
|
|
(test (c<= #\A #\Z) t)
|
|
(test (c<= #\A #\z) t)
|
|
(test (c<= #\a #\Z) nil)
|
|
(test (c<= #\a #\z) t)
|
|
(test (c<= #\Z #\A) nil)
|
|
(test (c<= #\Z #\a) t)
|
|
(test (c<= #\z #\A) nil)
|
|
(test (c<= #\z #\a) nil)
|
|
(test (c<= #\a #\b #\c) t)
|
|
(test (c<= #\a #\a #\b) t)
|
|
(test (c<= #\c #\c #\b) nil)
|
|
(test (c<= #\c #\b #\a) nil)
|
|
|
|
(test (c= #\+ #\+) t)
|
|
(test (c= #\+ #\-) nil)
|
|
(test (c= #\A #\A) t)
|
|
(test (c= #\A #\a) nil)
|
|
(test (c= #\a #\A) nil)
|
|
(test (c= #\a #\a) t)
|
|
(test (c= #\A #\Z) nil)
|
|
(test (c= #\A #\z) nil)
|
|
(test (c= #\a #\Z) nil)
|
|
(test (c= #\a #\z) nil)
|
|
(test (c= #\Z #\A) nil)
|
|
(test (c= #\Z #\a) nil)
|
|
(test (c= #\z #\A) nil)
|
|
(test (c= #\z #\a) nil)
|
|
(test (c= #\a #\a #\a) t)
|
|
(test (c= #\a #\a #\b #\a) nil)
|
|
|
|
(test (c> #\+ #\+) nil)
|
|
(test (c> #\+ #\-) nil)
|
|
(test (c> #\A #\A) nil)
|
|
(test (c> #\A #\a) nil)
|
|
(test (c> #\a #\A) t)
|
|
(test (c> #\a #\a) nil)
|
|
(test (c> #\A #\Z) nil)
|
|
(test (c> #\A #\z) nil)
|
|
(test (c> #\a #\Z) t)
|
|
(test (c> #\a #\z) nil)
|
|
(test (c> #\Z #\A) t)
|
|
(test (c> #\Z #\a) nil)
|
|
(test (c> #\z #\A) t)
|
|
(test (c> #\z #\a) t)
|
|
(test (c> #\a #\b #\c) nil)
|
|
(test (c> #\a #\a #\b) nil)
|
|
(test (c> #\c #\c #\b) nil)
|
|
(test (c> #\c #\b #\a) t)
|
|
|
|
(test (c>= #\+ #\+) t)
|
|
(test (c>= #\+ #\-) nil)
|
|
(test (c>= #\A #\A) t)
|
|
(test (c>= #\A #\a) nil)
|
|
(test (c>= #\a #\A) t)
|
|
(test (c>= #\a #\a) t)
|
|
(test (c>= #\A #\Z) nil)
|
|
(test (c>= #\A #\z) nil)
|
|
(test (c>= #\a #\Z) t)
|
|
(test (c>= #\a #\z) nil)
|
|
(test (c>= #\Z #\A) t)
|
|
(test (c>= #\Z #\a) nil)
|
|
(test (c>= #\z #\A) t)
|
|
(test (c>= #\z #\a) t)
|
|
(test (c>= #\a #\b #\c) nil)
|
|
(test (c>= #\a #\a #\b) nil)
|
|
(test (c>= #\c #\c #\b) t)
|
|
(test (c>= #\c #\b #\a) t)
|
|
|
|
;; Strings
|
|
|
|
(test (mkstr 0) "")
|
|
(test (mkstr 1) " ")
|
|
(test (mkstr 3 #\x) "xxx")
|
|
|
|
(test (numstr 0) "0")
|
|
(test (numstr 123) "123")
|
|
(test (numstr -123) "-123")
|
|
(test (numstr 0 2) "0")
|
|
(test (numstr 0 36) "0")
|
|
(test (numstr 12345 2) "11000000111001")
|
|
(test (numstr 12345 8) "30071")
|
|
(test (numstr 12345 16) "3039")
|
|
(test (numstr 12345 36) "9ix")
|
|
(test (numstr -12345 36) "-9ix")
|
|
|
|
(test (string) "")
|
|
(test (string #\x) "x")
|
|
(test (string #\a #\b #\c) "abc")
|
|
|
|
(test (strnum "") nil)
|
|
(test (strnum "+") nil)
|
|
(test (strnum "-") nil)
|
|
(test (strnum "0") 0)
|
|
(test (strnum "123") 123)
|
|
(test (strnum "-123") -123)
|
|
(test (strnum " 1") nil)
|
|
(test (strnum "1 ") nil)
|
|
(test (strnum "+1 ") nil)
|
|
(test (strnum "-1 ") nil)
|
|
(test (strnum "0" 2) 0)
|
|
(test (strnum "0" 36) 0)
|
|
(test (strnum "11000000111001" 2) 12345)
|
|
(test (strnum "30071" 8) 12345)
|
|
(test (strnum "3039" 16) 12345)
|
|
(test (strnum "9ix" 36) 12345)
|
|
(test (strnum "-9ix" 36) -12345)
|
|
|
|
(test (sconc "" "") "")
|
|
(test (sconc "foo") "foo")
|
|
(test (sconc "abc" "") "abc")
|
|
(test (sconc "" "def") "def")
|
|
(test (sconc) "")
|
|
(test (sconc "abc") "abc")
|
|
(test (sconc "abc" "def") "abcdef")
|
|
(test (sconc "abc" "def" "xyz") "abcdefxyz")
|
|
|
|
(test (scopy "") "")
|
|
(test (scopy "foobarbaz") "foobarbaz")
|
|
|
|
(test (si< "test" "test") nil)
|
|
(test (si< "test" "tesa") nil)
|
|
(test (si< "test" "tesz") t)
|
|
(test (si< "TEST" "tesa") nil)
|
|
(test (si< "TEST" "tesz") t)
|
|
(test (si< "test" "TESA") nil)
|
|
(test (si< "test" "TESZ") t)
|
|
(test (si< "TEST" "TESA") nil)
|
|
(test (si< "TEST" "TESZ") t)
|
|
(test (si< "test" "tes") nil)
|
|
(test (si< "test" "test0") t)
|
|
(test (si< "test0" "test") nil)
|
|
|
|
(test (si<= "test" "test") t)
|
|
(test (si<= "test" "tesa") nil)
|
|
(test (si<= "test" "tesz") t)
|
|
(test (si<= "TEST" "tesa") nil)
|
|
(test (si<= "TEST" "tesz") t)
|
|
(test (si<= "test" "TESA") nil)
|
|
(test (si<= "test" "TESZ") t)
|
|
(test (si<= "TEST" "TESA") nil)
|
|
(test (si<= "TEST" "TESZ") t)
|
|
(test (si<= "test" "tes") nil)
|
|
(test (si<= "test" "test0") t)
|
|
(test (si<= "test0" "test") nil)
|
|
|
|
(test (si= "abc" "abc") t)
|
|
(test (si= "abC" "abc") t)
|
|
(test (si= "aBc" "abc") t)
|
|
(test (si= "aBC" "abc") t)
|
|
(test (si= "Abc" "abc") t)
|
|
(test (si= "AbC" "abc") t)
|
|
(test (si= "ABc" "abc") t)
|
|
(test (si= "ABC" "abc") t)
|
|
(test (si= "aBc" "AbC") t)
|
|
(test (si= "abc" "abd") nil)
|
|
(test (si= "abc" "abcd") nil)
|
|
(test (si= "abcd" "abc") nil)
|
|
|
|
(test (si> "test" "test") nil)
|
|
(test (si> "test" "tesa") t)
|
|
(test (si> "test" "tesz") nil)
|
|
(test (si> "TEST" "tesa") t)
|
|
(test (si> "TEST" "tesz") nil)
|
|
(test (si> "test" "TESA") t)
|
|
(test (si> "test" "TESZ") nil)
|
|
(test (si> "TEST" "TESA") t)
|
|
(test (si> "TEST" "TESZ") nil)
|
|
(test (si> "test" "tes") t)
|
|
(test (si> "test" "test0") nil)
|
|
(test (si> "test0" "test") t)
|
|
|
|
(test (si>= "test" "test") t)
|
|
(test (si>= "test" "tesa") t)
|
|
(test (si>= "test" "tesz") nil)
|
|
(test (si>= "TEST" "tesa") t)
|
|
(test (si>= "TEST" "tesz") nil)
|
|
(test (si>= "test" "TESA") t)
|
|
(test (si>= "test" "TESZ") nil)
|
|
(test (si>= "TEST" "TESA") t)
|
|
(test (si>= "TEST" "TESZ") nil)
|
|
(test (si>= "test" "tes") t)
|
|
(test (si>= "test" "test0") nil)
|
|
(test (si>= "test0" "test") t)
|
|
|
|
(test (let ((s (mkstr 1))) (sfill s #\x) s) "x")
|
|
(test (let ((s (mkstr 3))) (sfill s #\z) s) "zzz")
|
|
|
|
(test (ssize "") 0)
|
|
(test (ssize "a") 1)
|
|
(test (ssize "ab") 2)
|
|
(test (ssize "abc") 3)
|
|
(test (ssize "Hello, World!") 13)
|
|
|
|
(test (sref "abc" 0) #\a)
|
|
(test (sref "abc" 1) #\b)
|
|
(test (sref "abc" 2) #\c)
|
|
|
|
(def s (string #\1 #\2 #\3))
|
|
(test (prog (sset s 0 #\a) s) "a23")
|
|
(test (prog (sset s 2 #\c) s) "a2c")
|
|
(test (prog (sset s 1 #\b) s) "abc")
|
|
|
|
(test (s< "test" "test") nil)
|
|
(test (s< "test" "tesa") nil)
|
|
(test (s< "test" "tesz") t)
|
|
(test (s< "TEST" "tesa") t)
|
|
(test (s< "TEST" "tesz") t)
|
|
(test (s< "test" "TESA") nil)
|
|
(test (s< "test" "TESZ") nil)
|
|
(test (s< "TEST" "TESA") nil)
|
|
(test (s< "TEST" "TESZ") t)
|
|
(test (s< "test" "tes") nil)
|
|
(test (s< "test" "test0") t)
|
|
(test (s< "test0" "test") nil)
|
|
|
|
(test (s<= "test" "test") t)
|
|
(test (s<= "test" "tesa") nil)
|
|
(test (s<= "test" "tesz") t)
|
|
(test (s<= "TEST" "tesa") t)
|
|
(test (s<= "TEST" "tesz") t)
|
|
(test (s<= "test" "TESA") nil)
|
|
(test (s<= "test" "TESZ") nil)
|
|
(test (s<= "TEST" "TESA") nil)
|
|
(test (s<= "TEST" "TESZ") t)
|
|
(test (s<= "test" "tes") nil)
|
|
(test (s<= "test" "test0") t)
|
|
(test (s<= "test0" "test") nil)
|
|
|
|
(test (s= "abc" "abc") t)
|
|
(test (s= "aBc" "abc") nil)
|
|
(test (s= "abc" "abd") nil)
|
|
(test (s= "abc" "abcd") nil)
|
|
(test (s= "abcd" "abc") nil)
|
|
|
|
(test (s> "test" "test") nil)
|
|
(test (s> "test" "tesa") t)
|
|
(test (s> "test" "tesz") nil)
|
|
(test (s> "TEST" "tesa") nil)
|
|
(test (s> "TEST" "tesz") nil)
|
|
(test (s> "test" "TESA") t)
|
|
(test (s> "test" "TESZ") t)
|
|
(test (s> "TEST" "TESA") t)
|
|
(test (s> "TEST" "TESZ") nil)
|
|
(test (s> "test" "tes") t)
|
|
(test (s> "test" "test0") nil)
|
|
(test (s> "test0" "test") t)
|
|
|
|
(test (s>= "test" "test") t)
|
|
(test (s>= "test" "tesa") t)
|
|
(test (s>= "test" "tesz") nil)
|
|
(test (s>= "TEST" "tesa") nil)
|
|
(test (s>= "TEST" "tesz") nil)
|
|
(test (s>= "test" "TESA") t)
|
|
(test (s>= "test" "TESZ") t)
|
|
(test (s>= "TEST" "TESA") t)
|
|
(test (s>= "TEST" "TESZ") nil)
|
|
(test (s>= "test" "tes") t)
|
|
(test (s>= "test" "test0") nil)
|
|
(test (s>= "test0" "test") t)
|
|
|
|
(test (substr "" 0 0) "")
|
|
(test (substr "abc" 0 0) "")
|
|
(test (substr "abc" 0 1) "a")
|
|
(test (substr "abc" 0 2) "ab")
|
|
(test (substr "abc" 0 3) "abc")
|
|
(test (substr "abc" 1 1) "")
|
|
(test (substr "abc" 1 2) "b")
|
|
(test (substr "abc" 1 3) "bc")
|
|
(test (substr "abc" 2 2) "")
|
|
(test (substr "abc" 2 3) "c")
|
|
(test (substr "abc" 3 3) "")
|
|
|
|
;; Vectors
|
|
|
|
(test (mkvec 0) #())
|
|
(test (mkvec 1) #(nil))
|
|
(test (mkvec 3 'x) #(x x x))
|
|
|
|
(test (vector) #())
|
|
(test (vector 'x) #(x))
|
|
(test (vector 1 2 3) #(1 2 3))
|
|
(test (vector (vector 'x)) #(#(x)))
|
|
|
|
(test (let ((v (vector))) (vfill v 'x) v) #())
|
|
(test (let ((v (vector 1 2 3))) (vfill v 'z) v) #(z z z))
|
|
|
|
(test (vconc #() #()) #())
|
|
(test (vconc #(f o o)) #(f o o))
|
|
(test (vconc #(a b c) #()) #(a b c))
|
|
(test (vconc #() #(d e f)) #(d e f))
|
|
(test (vconc) #())
|
|
(test (vconc #(a b c)) #(a b c))
|
|
(test (vconc #(a b c) #(d e f)) #(a b c d e f))
|
|
(test (vconc #(a b c) #(d e f) #(x y z)) #(a b c d e f x y z))
|
|
|
|
(test (vsize #()) 0)
|
|
(test (vsize #(a)) 1)
|
|
(test (vsize #(a b)) 2)
|
|
(test (vsize #(a b c)) 3)
|
|
(test (vsize #(1 2 3 #(4 5 6) 7 8 9)) 7)
|
|
|
|
(test (vref #(a b c) 0) 'a)
|
|
(test (vref #(a b c) 1) 'b)
|
|
(test (vref #(a b c) 2) 'c)
|
|
|
|
(def v (vector 1 2 3))
|
|
(test (prog (vset v 0 'a) v) #(a 2 3))
|
|
(test (prog (vset v 2 'c) v) #(a 2 c))
|
|
(test (prog (vset v 1 'b) v) #(a b c))
|
|
|
|
(test (subvec #() 0 0) #())
|
|
(test (subvec #(a b c) 0 0) #())
|
|
(test (subvec #(a b c) 0 1) #(a))
|
|
(test (subvec #(a b c) 0 2) #(a b))
|
|
(test (subvec #(a b c) 0 3) #(a b c))
|
|
(test (subvec #(a b c) 1 1) #())
|
|
(test (subvec #(a b c) 1 2) #(b))
|
|
(test (subvec #(a b c) 1 3) #(b c))
|
|
(test (subvec #(a b c) 2 2) #())
|
|
(test (subvec #(a b c) 2 3) #(c))
|
|
(test (subvec #(a b c) 3 3) #())
|
|
|
|
(test (let ((vec (vector 0 '(2 2 2 2) "Anna")))
|
|
(vset vec 1 '("Sue" "Sue"))
|
|
vec)
|
|
#(0 ("Sue" "Sue") "Anna"))
|
|
|
|
(test (veclist #(dah dah didah)) '(dah dah didah))
|
|
(test (listvec '(dididit dah)) #(dididit dah))
|
|
|
|
(test (let ((v (mkvec 5)))
|
|
(foreach (lambda (i)
|
|
(vset v i (* i i)))
|
|
'(0 1 2 3 4))
|
|
v)
|
|
#(0 1 4 9 16))
|
|
|
|
;; External Representation
|
|
|
|
(test (format nil) "nil")
|
|
(test (format t) "t")
|
|
(test (format 'foo) "foo")
|
|
(test (format ''foo) "'foo")
|
|
(test (format -123) "-123")
|
|
(test (format #\x) "#\\x")
|
|
(test (format #\sp) "#\\sp")
|
|
(test (format "") "\"\"")
|
|
(test (format "text") "\"text\"")
|
|
(test (format ()) "nil")
|
|
(test (format '(a b c)) "(a b c)")
|
|
(test (format '(a (b) c)) "(a (b) c)")
|
|
(test (format #()) "#()")
|
|
(test (format '#(a b c)) "#(a b c)")
|
|
(test (format '#(a #(b) c)) "#(a #(b) c)")
|
|
|
|
(test (read "nil") '(nil))
|
|
(test (read "t") '(t))
|
|
(test (read "foo") '(foo))
|
|
(test (read "'foo") '('foo))
|
|
(test (read "-123") '(-123))
|
|
(test (read "#\\x") '(#\x))
|
|
(test (read "#\\sp") '(#\sp))
|
|
(test (read "\"\"") '(""))
|
|
(test (read "\"text\"") '("text"))
|
|
(test (read "()") '(nil))
|
|
(test (read "(a b c)") '((a b c)))
|
|
(test (read "(a (b) c)") '((a (b) c)))
|
|
(test (read "#()") '(#()))
|
|
(test (read "#(a b c)") '(#(a b c)))
|
|
(test (read "#(a #(b) c)") '(#(a #(b) c)))
|
|
|
|
(test (read "1 2 3") '(1))
|
|
(test (read ")(") "unexpected ')'")
|
|
|
|
;; Input / Output
|
|
|
|
(test (inportp (inport)) t)
|
|
(test (outportp (outport)) t)
|
|
(test (outportp (errport)) t)
|
|
|
|
(if (existsp testfile) (delete testfile))
|
|
|
|
(test (with-outport testfile
|
|
(lambda (out)
|
|
(prin '(this is a test 1) out)
|
|
(close-port out)
|
|
(with-inport testfile read)))
|
|
'(this is a test 1))
|
|
|
|
(delete testfile)
|
|
|
|
(test (let ((out (open-outfile testfile)))
|
|
(prin '(this is a test 2) out)
|
|
(close-port out)
|
|
(let ((in (open-infile testfile)))
|
|
(let ((x (read in)))
|
|
(close-port in)
|
|
x)))
|
|
'(this is a test 2))
|
|
|
|
(delete testfile)
|
|
|
|
(test (let ((out (open-outfile testfile)))
|
|
(princ "Hello-World" out)
|
|
(close-port out)
|
|
(let ((in (open-infile testfile)))
|
|
(let ((x (read in)))
|
|
(close-port in)
|
|
x)))
|
|
'hello-world)
|
|
|
|
(test (prog (with-outfile testfile
|
|
(lambda () (prin '(this is a test 3))))
|
|
(with-infile testfile read))
|
|
'(this is a test 3))
|
|
|
|
(test (prog (with-outfile testfile2
|
|
(lambda () (prin '(this is a test 4))))
|
|
(rename testfile2 testfile)
|
|
(with-infile testfile read))
|
|
'(this is a test 4))
|
|
|
|
(defun (visibility-check x)
|
|
(delete testfile)
|
|
(let ((out (open-outfile testfile)))
|
|
(prin x out)
|
|
(princ #\sp out)
|
|
(princ x out)
|
|
(princ #\sp out)
|
|
(prin 'the-end out)
|
|
(close-port out)
|
|
(let ((in (open-infile testfile)))
|
|
(let ((vis (read in)))
|
|
(let ((invis (read in)))
|
|
(close-port in)
|
|
(list vis invis))))))
|
|
|
|
(test (visibility-check nil) '(nil nil))
|
|
(test (visibility-check 1) '(1 1))
|
|
(test (visibility-check 12341234)
|
|
'(12341234 12341234))
|
|
(test (visibility-check -12341234)
|
|
'(-12341234 -12341234))
|
|
(test (visibility-check #\A) '(#\A a))
|
|
(test (visibility-check "x y") '("x y" x))
|
|
(test (visibility-check 'foo) '(foo foo))
|
|
(test (visibility-check '(1 2 3)) '((1 2 3) (1 2 3)))
|
|
(test (visibility-check #(1 2 3)) '(#(1 2 3) #(1 2 3)))
|
|
(test (visibility-check " ") '(" " the-end))
|
|
(test (visibility-check #\sp) '(#\sp the-end))
|
|
(test (visibility-check #\nl) '(#\nl the-end))
|
|
|
|
(delete testfile)
|
|
|
|
(test (prog (with-outfile testfile print)
|
|
(with-infile testfile readc))
|
|
#\nl)
|
|
|
|
(delete testfile)
|
|
|
|
(test (prog (close-port (open-outfile testfile))
|
|
(let* ((in (open-infile testfile))
|
|
(e (read in)))
|
|
(close-port in)
|
|
(eofp e)))
|
|
t)
|
|
|
|
(delete testfile)
|
|
|
|
(def foo 'bar)
|
|
(let ((out (open-outfile testfile)))
|
|
(prin '(def foo 'baz) out)
|
|
(close-port out))
|
|
(load "test.tmp")
|
|
(test foo 'baz)
|
|
|
|
(defun (with-range lo hi fn)
|
|
(if (< hi lo)
|
|
nil
|
|
(let ((c (fn lo)))
|
|
(cons c (with-range (+ 1 lo) hi fn)))))
|
|
|
|
(delete testfile)
|
|
|
|
(test (with-outport testfile
|
|
(lambda (out)
|
|
(with-range 32 126
|
|
(lambda (x)
|
|
(writec (char x) out)
|
|
(char x)))))
|
|
(with-range 32 126 char))
|
|
|
|
(defun (while-not-eof input fn)
|
|
(let ((c (fn input)))
|
|
(if (eofp c)
|
|
nil
|
|
(cons c (while-not-eof input fn)))))
|
|
|
|
(test (let ((in (open-infile testfile)))
|
|
(while-not-eof in readc))
|
|
(with-range 32 126 char))
|
|
|
|
(test (let ((in (open-infile testfile)))
|
|
(let ((c (peekc in)))
|
|
(cons c (while-not-eof in readc))))
|
|
(cons #\sp (with-range 32 126 char)))
|
|
|
|
(test (prog (with-outfile testfile
|
|
(lambda ()
|
|
(princ "hello")))
|
|
(with-infile testfile readln))
|
|
"hello")
|
|
|
|
(test (prog (with-outfile testfile
|
|
(lambda ()
|
|
(princ "hello\nworld\n")))
|
|
(with-infile testfile readln))
|
|
"hello")
|
|
|
|
; Does GC close unused files?
|
|
; Set NFILES to a number that is greater than NPORTS in ls9.c
|
|
|
|
(let ((NFILES 100))
|
|
(test (labels
|
|
((open
|
|
(lambda (n)
|
|
(open-infile testfile)
|
|
(if (< n 1)
|
|
'okay
|
|
(open (- n 1))))))
|
|
(open NFILES))
|
|
'okay))
|
|
|
|
; LOAD
|
|
|
|
(with-outfile testfile
|
|
(lambda ()
|
|
(print '(def foo 'bar))))
|
|
|
|
(test (prog (load testfile) foo) 'bar)
|
|
|
|
(with-outfile testfile
|
|
(lambda ()
|
|
(print '(defun (foo x)
|
|
(or (= 0 x)
|
|
(cons 1 (foo (- x 1))))))))
|
|
|
|
(test (prog (load testfile) (foo 7)) '(1 1 1 1 1 1 1 . t))
|
|
|
|
;; Misc
|
|
|
|
(test (let ((g (gc)))
|
|
(and (listp g)
|
|
(= (length g) 2))
|
|
(fixp (car g))
|
|
(fixp (cadr g)))
|
|
t)
|
|
|
|
;; APPLY of built-in functions
|
|
|
|
(test (listp (apply cmdline '())) t)
|
|
(test (listp (apply gc'())) t)
|
|
(test (inportp (apply inport '())) t)
|
|
(test (outportp (apply outport '())) t)
|
|
(test (outportp (apply errport '())) t)
|
|
(test (symbolp (apply gensym '())) t)
|
|
|
|
(test (apply abs '(-1)) 1)
|
|
(test (apply car '((a . b))) 'a)
|
|
(test (apply cdr '((a . b))) 'b)
|
|
(test (apply caar '(((a . b) . (c . d)))) 'a)
|
|
(test (apply cadr '(((a . b) . (c . d)))) 'c)
|
|
(test (apply cdar '(((a . b) . (c . d)))) 'b)
|
|
(test (apply cddr '(((a . b) . (c . d)))) 'd)
|
|
(test (apply caaar (list tree)) '(1 . 2))
|
|
(test (apply caadr (list tree)) '(9 . 10))
|
|
(test (apply cadar (list tree)) '(5 . 6))
|
|
(test (apply caddr (list tree)) '(13 . 14))
|
|
(test (apply cdaar (list tree)) '(3 . 4))
|
|
(test (apply cdadr (list tree)) '(11 . 12))
|
|
(test (apply cddar (list tree)) '(7 . 8))
|
|
(test (apply cdddr (list tree)) '(15 . 16))
|
|
(test (apply caaaar (list tree)) 1)
|
|
(test (apply caaadr (list tree)) 9)
|
|
(test (apply caadar (list tree)) 5)
|
|
(test (apply caaddr (list tree)) 13)
|
|
(test (apply cadaar (list tree)) 3)
|
|
(test (apply cadadr (list tree)) 11)
|
|
(test (apply caddar (list tree)) 7)
|
|
(test (apply cadddr (list tree)) 15)
|
|
(test (ctagp (apply catch (list (lambda (x) x)))) t)
|
|
(test (apply ctagp (list (catch (lambda (x) x)))) t)
|
|
(test (apply cdaaar (list tree)) 2)
|
|
(test (apply cdaadr (list tree)) 10)
|
|
(test (apply cdadar (list tree)) 6)
|
|
(test (apply cdaddr (list tree)) 14)
|
|
(test (apply cddaar (list tree)) 4)
|
|
(test (apply cddadr (list tree)) 12)
|
|
(test (apply cdddar (list tree)) 8)
|
|
(test (apply cddddr (list tree)) 16)
|
|
(test (apply charval '(#\A)) 65)
|
|
(test (apply constp '((1 2 3))) t)
|
|
(test (apply alphac '(#\M)) t)
|
|
(test (apply downcase '(#\M)) #\m)
|
|
(test (apply lowerc '(#\m)) t)
|
|
(test (apply numeric '(#\5)) t)
|
|
(test (apply upperc '(#\M)) t)
|
|
(test (apply upcase '(#\m)) '#\M)
|
|
(test (apply whitec '(#\sp)) t)
|
|
(test (apply charp '(#\A)) t)
|
|
(test (apply eofp '(x)) nil)
|
|
(test (apply evenp '(2)) t)
|
|
(test (apply inportp @(,(inport))) t)
|
|
(test (apply char '(65)) #\A)
|
|
(test (apply fixp '(5)) t)
|
|
(test (prog (apply flush @(,(outport))) t) t)
|
|
(test (apply length '((1 2 3))) 3)
|
|
(test (apply liststr '((#\f #\o #\b))) "fob")
|
|
(test (apply listvec '((1 2 3))) '#(1 2 3))
|
|
(test (apply mx '(foo)) 'foo)
|
|
(test (apply mx1 '(foo)) 'foo)
|
|
(test (apply not '(nil)) t)
|
|
(test (apply null '(nil)) t)
|
|
(test (apply oddp '(3)) t)
|
|
(test (apply outportp @(,(outport))) t)
|
|
(test (apply pair @((a . b))) t)
|
|
(test (apply funp @(,(lambda (x) x))) t)
|
|
(test (apply rever '((1 2 3))) '(3 2 1))
|
|
(test (apply nrever (list (list 1 2 3))) '(3 2 1))
|
|
(test (apply strlist '("foo")) '(#\f #\o #\o))
|
|
(test (apply symbol '("foo")) 'foo)
|
|
(test (apply ssize '("foo")) 3)
|
|
(test (apply stringp '("foo")) t)
|
|
(test (apply symname '(foo)) "foo")
|
|
(test (apply symbolp '(foo)) t)
|
|
(test (apply untag '(nil)) nil)
|
|
(test (apply veclist '(#(foo bar baz))) '(foo bar baz))
|
|
(test (apply vsize '(#(foo bar baz))) 3)
|
|
(test (apply vectorp '(#(foo bar baz))) t)
|
|
|
|
(test (apply assq '(b ((a) (b) (c)))) '(b))
|
|
(test (apply assv '(2 ((1) (2) (3)))) '(2))
|
|
(test (apply c< '(#\a #\b)) t)
|
|
(test (apply c<= '(#\a #\b)) t)
|
|
(test (apply c= '(#\a #\b)) nil)
|
|
(test (apply c> '(#\a #\b)) nil)
|
|
(test (apply c>= '(#\a #\b)) nil)
|
|
(test (apply cons '(a b)) '(a . b))
|
|
(test (apply eq '(x x)) t)
|
|
(test (apply eqv '(5 5)) t)
|
|
(test (apply nreconc @(,(list 1 2 3) (4 5 6))) '(3 2 1 4 5 6))
|
|
(test (apply nth '(1 (1 2 3))) 2)
|
|
(test (apply nth-tail '(1 (1 2 3))) '(2 3))
|
|
(test (apply div '(14 4)) 3)
|
|
(test (apply reconc '((1 2 3) (4 5 6))) '(3 2 1 4 5 6))
|
|
(test (apply rem '(14 4)) 2)
|
|
(test (apply setcar (list (cons 1 2) 0)) '(0 . 2))
|
|
(test (apply setcdr (list (cons 1 2) 0)) '(1 . 0))
|
|
(test (apply s< '("foo" "bar")) nil)
|
|
(test (apply s<= '("foo" "bar")) nil)
|
|
(test (apply s= '("foo" "bar")) nil)
|
|
(test (apply s> '("foo" "bar")) t)
|
|
(test (apply s>= '("foo" "bar")) t)
|
|
(test (apply si< '("Foo" "bar")) nil)
|
|
(test (apply si<= '("Foo" "bar")) nil)
|
|
(test (apply si= '("Foo" "bar")) nil)
|
|
(test (apply si> '("Foo" "bar")) t)
|
|
(test (apply si>= '("Foo" "bar")) t)
|
|
(test (apply stringp '("foo")) t)
|
|
(test (apply sref '("abc" 1)) #\b)
|
|
(test (apply sfill (list (string #\x #\x #\x) #\z)) "zzz")
|
|
(test (apply sset (list (string #\f #\o #\o) 2 #\b)) "fob")
|
|
(test (catch (lambda (x) (apply throw (list x 'foo)))) 'foo)
|
|
(test (apply vfill (list (vector 'x 'x 'x) 'zzz)) '#(zzz zzz zzz))
|
|
(test (apply vref '(#(a b c) 1)) 'b)
|
|
(test (apply vset (list (vector 'f 'o 'o) 2 'b)) #(f o b))
|
|
(test (apply substr '("abcdef" 2 4)) "cd")
|
|
(test (apply subvec '(#(a b c d e f) 2 4)) #(c d))
|
|
|
|
(test (ssize (apply mkstr '(10))) 10)
|
|
(test (apply mkstr '(10 #\x)) "xxxxxxxxxx")
|
|
(test (vsize (apply mkvec '(10))) 10)
|
|
(test (apply mkvec '(10 x)) '#(x x x x x x x x x x))
|
|
(test (apply numstr '(123)) "123")
|
|
(test (apply numstr '(123 8)) "173")
|
|
(test (apply strnum '("123")) 123)
|
|
(test (apply strnum '("123" 8)) 83)
|
|
|
|
(test (apply + '()) 0)
|
|
(test (apply + '(1)) 1)
|
|
(test (apply + '(1 2)) 3)
|
|
(test (apply + '(1 2 3 4 5)) 15)
|
|
(test (apply * '()) 1)
|
|
(test (apply * '(2)) 2)
|
|
(test (apply * '(2 3)) 6)
|
|
(test (apply * '(1 2 3 4 5)) 120)
|
|
(test (apply conc '()) ())
|
|
(test (apply conc '(foo)) 'foo)
|
|
(test (apply conc '((foo) (bar))) '(foo bar))
|
|
(test (apply conc '((foo) (bar) (baz))) '(foo bar baz))
|
|
(test (apply nconc '()) ())
|
|
(test (apply nconc @(foo)) 'foo)
|
|
(test (apply nconc @(,(list 'foo) (bar))) '(foo bar))
|
|
(test (apply nconc @(,(list 'foo) ,(list 'bar) (baz))) '(foo bar baz))
|
|
(test (apply sconc '()) "")
|
|
(test (apply sconc '("foo")) "foo")
|
|
(test (apply sconc '("foo" "bar")) "foobar")
|
|
(test (apply sconc '("foo" "-" "bar" "-" "baz")) "foo-bar-baz")
|
|
(test (apply vconc '()) '#())
|
|
(test (apply vconc '(#(foo))) '#(foo))
|
|
(test (apply vconc '(#(foo) #(bar))) '#(foo bar))
|
|
(test (apply vconc '(#(foo) #(bar) #(baz))) '#(foo bar baz))
|
|
|
|
(test (apply bitop '(1 7 14)) 6)
|
|
(test (apply bitop '(1 7 14 4)) 4)
|
|
|
|
(test (apply max '(1)) 1)
|
|
(test (apply max '(1 2)) 2)
|
|
(test (apply max '(1 2 3)) 3)
|
|
(test (apply min '(1)) 1)
|
|
(test (apply min '(1 2)) 1)
|
|
(test (apply min '(1 2 3)) 1)
|
|
(test (apply - '(1)) -1)
|
|
(test (apply - '(1 2)) -1)
|
|
(test (apply - '(1 2 3 4 5)) -13)
|
|
|
|
(test (apply = '(1 1)) t)
|
|
(test (apply = '(1 1 1)) t)
|
|
(test (apply = '(1 1 1 1 1)) t)
|
|
(test (apply < '(1 2)) t)
|
|
(test (apply < '(1 2 3)) t)
|
|
(test (apply < '(1 2 3 4 5)) t)
|
|
(test (apply <= '(1 2)) t)
|
|
(test (apply <= '(1 2 2)) t)
|
|
(test (apply <= '(1 2 3 3 5)) t)
|
|
(test (apply > '(2 1)) t)
|
|
(test (apply > '(3 2 1)) t)
|
|
(test (apply > '(5 4 3 2 1)) t)
|
|
(test (apply >= '(2 1)) t)
|
|
(test (apply >= '(3 2 2)) t)
|
|
(test (apply >= '(5 4 4 2 1)) t)
|
|
|
|
(test (apply apply @(,cons (a b))) '(a . b))
|
|
(test (apply apply @(,list a b (c d))) '(a b c d))
|
|
|
|
;; Regression Tests
|
|
|
|
(def x 1)
|
|
|
|
(defun (g) x)
|
|
|
|
(defun (f0)
|
|
(let ((x 0))
|
|
(setq x (g))
|
|
x))
|
|
|
|
(defun (f1)
|
|
(let ((x 0))
|
|
(let ()
|
|
(setq x (g))
|
|
x)))
|
|
|
|
(test (f0) 1)
|
|
(test (f1) 1)
|
|
|
|
(defun (f2)
|
|
(let ((x 2))
|
|
(let ((r (g)))
|
|
r)))
|
|
|
|
(test (f2) 1)
|
|
|
|
;; Postlude
|
|
|
|
(cond ((= 0 Errors)
|
|
(princ "Everything fine!"))
|
|
(else
|
|
(princ Errors)
|
|
(if (> Errors 1)
|
|
(princ " errors.")
|
|
(princ " error."))))
|
|
(terpri)
|
|
|
|
(if (existsp testfile) (delete testfile))
|