home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lisp
/
interpre
/
pclisp
/
qua.l
< prev
next >
Wrap
Lisp/Scheme
|
1990-02-01
|
53KB
|
760 lines
;; Q&A.L - quality assurance tests
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; A set of calls and correct results to make sure that PC-LISP is
;; behaving itself. These are run after every change to the source to
;; make sure things are kosher. If a new function is added a set of
;; tests should be added also. Test results are printed on file whose
;; open port is 'where'.
(defun Q&A(ListOfTests where tracing)
(prog (input result wwanted)
(patom (ascii 10) where)
(patom '|=============== NEXT TEST SUIT ================| where)
(patom (ascii 10) where)
LAB: (cond ((null ListOfTests) (return t)))
(setq input (caar ListOfTests) wanted (cadar ListOfTests))
(cond (tracing (patom input)(patom "\n")))
(setq wanted (eval wanted))
(setq result (eval input))
(setq wwanted (eval wanted))
(cond ((and (null (equal wwanted result))
(null (NearlyEqual wwanted result)))
(patom "FAIL: Input, Expected and Actual :\n" where)
(patom input)
(patom "\n" where)
(patom wwanted)
(patom "\n" where)
(patom result)
(patom "\n" where)))
(setq ListOfTests (cdr ListOfTests))
(go LAB:)
)
)
;; TEST OF MATH FUNCTIONS
;; ~~~~~~~~~~~~~~~~~~~~~~
;; Test the math functions to make sure they are producing sensible results.
;; No precision tests, these were done before math library was added to PC-LISP
(setq List#1_Math_Functions
'( ( (abs 5000) 5000 )
( (abs -5000) 5000 )
( (acos (cos 1.0)) 1.0 )
( (asin (sin 1.0)) 1.0 )
( (acos (cos .45)) .45 )
( (asin (sin .45)) .45 )
( (sum (times (cos .45) (cos .45) )
(times (sin .45) (sin .45) )) 1.0 )
( (atan 1.0 1.0 ) .785398163 )
( (atan .22 1.0 ) .216550305 )
( (log 2.718281828) 1.0 )
( (log (exp 10)) 10 )
( (expt 2 8) 256 )
( (expt 3 6) (* 3 3 3 3 3 3 ))
( (expt 2.2 3.3) (exp (times 3.3 (log 2.2))) )
( (fact 0) 1 )
( (fact 10) (* 10 (fact 9)) )
( (fact 5) (* 5 4 3 2 1) )
( (log10 (* 10 10 10 10 10 10 10 10)) 8 )
( (log10 1) 0 )
( (max) 0 )
( (min) 0 )
( (max 14) 14 )
( (min 14) 14 )
( (max 0 1 2 -3 10 -14 50 100 0 -10 -19) 100 )
( (min 0 1 2 -3 10 -14 50 100 0 -10 -13) -14 )
( (mod 8 2) 0 )
( (mod 16 3) 1 )
( (mod -16 -3) -1 )
( (mod -16 3) -1 )
( (mod 16 -3) 1 )
( (> 15 (random 15)) t )
( (> 1 (random 1)) t )
( (not (= (random) (random))) t )
( (sqrt (* 2345 2345)) 2345 )
( (sqrt 49) 7 )
( (sqrt 1) 1 )
( (*) 1 )
( (/) 1 )
( (+) 0 )
( (-) 0 )
( (* 5 4 3 2 1) (fact 5) )
( (/ 1000 10 10 10) 1 )
( (+ 1 2 3 4 5) 15 )
( (- 10 1 2 3 1 2 1) 0 )
( (add1 8) 9 )
( (add1 8.0) 9.0 )
( (sub1 8) 7 )
( (sub1 8.0) 7.0 )
( (times) 1 )
( (add) 0 )
( (diff) 0 )
( (quotient) 1 )
( (times 2.0) 2.0 )
( (add 2.0) 2.0 )
( (diff 2.0) 2.0 )
( (quotient 2.0) 2.0 )
( (add 2.2 2.2 2.2 2.2 2.2) 11 )
( (diff 11 2.2 2.2 2.2 2.2 2.2) 0 )
( (times 1.0 2.0 3.0 4.0 5.0) (fact 5) )
( (quotient 8.0 2.0 2.0 2.0) 1 )
( (oddp 10) nil )
( (oddp 0) nil )
( (oddp -10) nil )
( (oddp 11) t )
( (evenp -11) nil )
( (evenp 10) t )
( (evenp 0) t )
( (evenp -10) t )
( (evenp 11) nil )
( (evenp -11) nil )
( (and (zerop 0) (zerop 0.0)) t )
( (zerop 8) nil )
( (zerop -8.0) nil )
( (minusp 0) nil )
( (minusp 8.0) nil )
( (minusp 8) nil )
( (minusp -1.0) t )
( (plusp 0) nil )
( (plusp -8.0) nil )
( (plusp -8) nil )
( (plusp 1.0) t )
( (< 0 0) nil )
( (> 0 0) nil )
( (= 0 0) t )
( (< -10 10) t )
( (> 10 -10) t )
( (= -10 -10) t )
( (< 10 -10) nil )
( (> -10 10) nil )
( (1+ 0) 1 )
( (1- 0) -1 )
( (1+ 100) 101 )
( (1- -100) -101 )
( (greaterp 1.0) t )
( (lessp 1.0) t )
( (greaterp 10.0 9.9 9.8 9 8.9) t )
( (lessp 1.0 2.0 3.0 3.9 4 5 6 7) t )
( (greaterp 10.0 9.9 9.8 9 9.0) nil )
( (lessp 1.0 2.0 3.0 4.0 4 5 6 7) nil )
( (fixp 10) t )
( (fixp -10.0) nil )
( (fixp 'a) nil )
( (fixp '(a)) nil )
( (fixp poport) nil )
( (fixp "no") nil )
( (numberp 0) t )
( (numberp 0.0) t )
( (numberp 'a) nil )
( (numberp '(a)) nil )
( (numberp poport) nil )
( (numberp "no") nil )
( (lsh 1 8) 256 )
( (lsh 256 -8) 1 )
)
)
;; TEST OF SIMPLE PREDICATE FUNCTIONS
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; T and Nil quality assurance tests. Make sure that they behave as they should
;; do. Note particularly that imploding and exploding of nil should produce the
;; nil atom/list.
(setq List#2_Predicates
'( ( (eq nil nil) t )
( (eq 10 10) t )
( (eq 11 10) nil )
( (eq nil t) nil )
( (eq 'nil nil) t )
( (eq "hi" "hi") nil )
( (atom nil) t )
( (atom "hi") t )
( (atom Hunk_126) nil )
( (equal ''nil ''()) t )
( (equal '("hi") '("hi")) t )
( (equal '(a . (b . (c . (d)))) '(a b c d)) t )
( (equal Hunk_126 Hunk_126) t )
( (eq Hunk_126 Hunk_126) t )
( (equal Hunk_50 Hunk_126) nil )
( (eq Hunk_50 Hunk_126) nil )
( (atom t) t )
( (equal (explode nil) '(n i l)) t )
( (eq (implode '(n i l)) nil) t )
( (eq (implode '("n" "i" "l")) nil) t )
( (eq nil t) nil )
( (eq 'a 'a) t )
( (eq 2.8 2.8) nil )
( (eq '(a b) '(a b)) nil )
( (equal '(a b) '(a b)) t )
( (equal '((a)((b))) '((a)((b))) ) t )
( (equal '((a)((d))) '((a)((b))) ) nil )
( (eq Data_1 Data_1) t )
( (equal Data_1 Data_1) t )
( (equal (getd 'Data_Array) (getd 'Data_Array2)) t )
( (null nil) t )
( (not nil) t )
( (null 'a) nil )
( (not 'a) nil )
( (not "a") nil )
( (alphalessp 'abc 'abd) t )
( (alphalessp 'abd 'abc) nil )
( (alphalessp 'abc 'abc) nil )
( (alphalessp "abc" "abd") t )
( (alphalessp 'abd "abc") nil )
( (alphalessp "abc" 'abc) nil )
( (arrayp (getd 'Data_Array)) t )
( (arrayp 8) nil )
( (arrayp 8.8) nil )
( (arrayp poport) nil )
( (atom 'a) t )
( (atom 8) t )
( (atom Data_1) nil )
( (atom poport) t )
( (null (boundp 'poport)) nil )
( (boundp (gensym)) nil )
( (floatp 'a) nil )
( (floatp 8.0) t )
( (floatp 8 ) nil )
( (floatp '|800|) nil )
( (floatp Data_1) nil )
( (floatp poport) nil )
( (floatp "hi") nil )
( (floatp Hunk_1) nil )
( (hunkp 'a) nil )
( (hunkp 8) nil )
( (hunkp '|800|) nil )
( (hunkp Data_1) nil )
( (hunkp poport) nil )
( (hunkp "hi") nil )
( (hunkp Hunk_1) t )
( (listp 'a) nil )
( (listp 8) nil )
( (listp '|800|) nil )
( (listp Data_1) t )
( (listp poport) nil )
( (listp "hi") nil )
( (listp Hunk_1) nil )
( (portp 'a) nil )
( (portp 8) nil )
( (portp '|800|) nil )
( (portp Data_1) nil )
( (portp poport) t )
( (portp "hi") nil )
( (portp Hunk_1) nil )
( (stringp 'a) nil )
( (stringp 8) nil )
( (stringp '|800|) nil )
( (stringp Data_1) nil )
( (stringp poport) nil )
( (stringp "hi") t )
( (stringp Hunk_1) nil )
( (and) t )
( (or) t )
( (and t) t )
( (or t) t )
( (and t t) t )
( (and t nil) nil )
( (or t nil) t )
( (or nil nil nil nil t nil nil nil) t )
( (or nil nil nil nil nil nil nil nil) nil )
( (setq x 1) 1 )
( (and (atom '(a)) (setq x 2)) nil )
( (= x 2) nil )
( (or (+ 2 2) (setq x 3)) 4 )
( (= x 3) nil )
( (or nil (+ 3 4) nil) 7 )
( (and (+ 2 2) (+ 2 3) t (+ 2 4)) 6 )
)
)
;; TEST OF SELECTORS AND CREATORS
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; Check all functions that have no side effects that select part of a list
;; or atom, or that create a new list or atom for quality.
(setq List#3_Selectors_Creators
'( ( (append) nil )
( (append nil) nil )
( (append nil nil nil) nil )
( (append '(a) nil '(b)) ''(a b) )
( (append '(a b (g)) nil '(h(i)) '(j(k))) ''(a b (g) h (i) j (k)) )
( (nconc ) nil )
( (nconc nil) nil )
( (nconc nil nil nil) nil )
( (nconc '(a) nil '(b)) ''(a b) )
( (nconc '(a b (g)) nil '(h(i)) '(j(k))) ''(a b (g) h (i) j (k)) )
( (ascii 97) ''a )
( (ascii 126) ''|~| )
( (assoc 'a nil) nil )
( (assoc nil nil) nil )
( (assoc 'a '((a . b) (c . d) (e . f))) ''(a . b) )
( (assoc 'x '((a . b) (c . d) (e . f))) nil )
( (assoc '(e) '((a . b) (c . d) ((e) . f))) ''((e) . f) )
( (car nil) nil )
( (cdr nil) nil )
( (cdr '(a)) nil )
( (cdr '(a . b)) ''b )
( (cdr '(a b c)) ''(b c) )
( (car '(a)) ''a )
( (car '(a . b)) ''a )
( (car '((a))) ''(a) )
( (caaar '(( (a) xx ) xx ) ) ''a )
( (cdddr '(a b c d e) ) ''(d e) )
( (cadddr '(a b c d e xx xx )) ''d )
( (cons 'a nil) ''(a) )
( (cons 'a 'nil) ''(a) )
( (cons 'a 'b) ''(a . b))
( (cons 'a '(b c)) ''(a b c))
( (cons '(a) 'b) ''((a) . b) )
( (cons nil nil) ''(nil) )
( (explode nil) ''(n i l) )
( (explode 'a) ''(a) )
( (explode 'abcdefg) ''(a b c d e f g))
( (explode "abcdefg") ''(a b c d e f g))
( (explode 987) ''(|9| |8| |7|) )
( (exploden nil) ''(110 105 108) )
( (exploden 'abc) ''(97 98 99) )
( (exploden "abc") ''(97 98 99) )
( (eq 'a (implode (explode 'a))) t )
( (eq 'abcd (implode (explode 'abcd))) t )
( (eq nil (implode (explode nil))) t )
( (length nil) 0 )
( (length '(a)) 1 )
( (length '((a))) 1 )
( (length '(a b c d)) 4 )
( (ldiff nil nil) nil )
( (ldiff '(a b c) nil) ''(a b c) )
( (ldiff '(a b c) '(a)) ''(b c) )
( (ldiff '(a b c 1 2) '(a b c 1 2)) nil )
( (ldiff '("a" "b" "c") '("a" "b" "c")) ''("a" "b" "c") )
( (list) nil )
( (list 'a) ''(a) )
( (list 'a 'b 'c) ''(a b c) )
( (list 'a '(b) 'c) ''(a(b)c) )
( (list nil nil nil nil nil) ''(nil nil nil nil nil) )
( (member 'a '(x y z a b c)) ''(a b c) )
( (memq 'a '(x y z a b c)) ''(a b c) )
( (member 'k '(x y z a b c)) nil )
( (memq 'k '(x y z a b c)) nil )
( (member '(a b) '(x y z (a b) c)) ''((a b) c) )
( (memq '(a b) '(x y z (a b) c)) nil )
( (listp (setq z '((a b) (c d) e))) t )
( (memq (cadr z) z) ''((c d) e) )
( (nth 0 nil) nil )
( (nth 10 nil) nil )
( (nth -10 nil) nil )
( (nth 0 '((a)b c d)) ''(a) )
( (nth 3 '(a b c d)) ''d )
( (nthchar nil 0) nil )
( (nthchar nil 1) ''n )
( (nthchar nil 3) ''l )
( (nthchar 'abcde 3) ''c )
( (nthchar "abcde" 1) ''a )
( (nthchar 'abcde 5) ''e )
( (nthchar 'abcde 6) nil )
( (nthchar "abcde" -1) nil )
( (pairlis '(a) '(b) nil) ''((a . b)) )
( (pairlis '((a)) '((b)) nil) ''(((a) b)) )
( (pairlis '(a c) '(d f) '(g h)) ''((a . d)(c . f) g h) )
( (quote nil) nil )
( (quote a) ''a )
( (quote (a b c)) ''(a b c) )
( (remove 'a '(a b c)) ''(b c) )
( (remove 'a '(a a b c) 1) ''(a b c) )
( (remove 'a nil 4) nil )
( (remq 1 '(a a 1 c) 1) ''(a a c) )
( (remq 'a '(a a 1 c) 1) ''(a 1 c) )
( (reverse nil) nil )
( (reverse '(a)) ''(a) )
( (reverse '(a b)) ''(b a) )
( (reverse '(a b c d e)) ''(e d c b a) )
( (reverse (reverse '(a b c d e))) ''(a b c d e) )
( (reverse '((a b) nil c d)) ''(d c nil (a b)) )
( (> 50 (sizeof 'symbol)) t )
( (> 50 (sizeof 'flonum)) t )
( (> 50 (sizeof 'port)) t )
( (> 50 (sizeof "fixnum")) t )
( (> 50 (sizeof 'string)) t )
( (> 50 (sizeof "list")) t )
( (> 50 (sizeof "array")) t )
( (subst 'a 'b nil) nil )
( (subst 'a 'b '(a . b)) ''(a . a) )
( (subst 'a 'b '(a b a b)) ''(a a a a) )
( (subst 'a '(1 2) '((1 2) (1 2) ((1 2)))) ''(a a (a)) )
( (listp (setq L '(a b c))) t )
( (dsubst 'a 'b L) ''(a a c) )
( (equal L '(a a c)) t )
( (memusage nil) 0 )
( (memusage 'a) (+ 2 (sizeof 'symbol)) )
( (memusage "a") (+ 2 (sizeof "string")) )
( (fixp (memusage (oblist))) t )
( (type nil) ''list )
( (type t) ''symbol )
( (type 8) ''fixnum )
( (type '|8|) ''symbol )
( (type poport) ''port )
( (type "hi") ''string )
( (type '(a b c)) ''list )
( (type (getd 'Data_Array)) ''array )
( (last nil) nil )
( (last '(a)) ''a )
( (last '(a . b)) ''b )
( (last '(a b c (d e))) ''(d e) )
( (nthcdr 10 nil) nil )
( (nthcdr 0 '(a)) ''(a) )
( (nthcdr 1 '(a . b)) ''b )
( (nthcdr 3 '(a b c (d e))) ''((d e)) )
( (nthcdr 2 '(a b c (d e))) ''(c(d e)) )
( (nthcdr -1.0 '(a b)) ''(nil a b) )
( (character-index 'abcde 'a) 1 )
( (character-index 'abcde 'b) 2 )
( (character-index 'abcde 'e) 5 )
( (character-index 'abcde 'x) nil )
( (character-index "abcde" "cde") 3 )
( (character-index "" "") nil )
( (get_pname 'junk) "junk" )
( (get_pname "junk") "junk" )
( (substring "abcdefghijklm" 0) nil )
( (substring "abcdefghijklm" 1) "abcdefghijklm" )
( (substring "abcdefghijklm" 1 1) "a" )
( (substring "abcdefghijklm" 3 3) "cde" )
( (substring "abcdefghijklm" 13 1) "m" )
( (substring "abcdefghijklm" 13 2) nil )
( (substring "abcdefghijklm" 12 2) "lm" )
( (substring 'abcdefghijklm -1 1) "m" )
( (substring "abcdefghijklm" -2) "lm" )
( (substring 'abcdefghijklm -30) nil )
( (substring "abcdefghijklm" 10 40) nil )
( (concat) nil )
( (concat nil) nil )
( (concat 'a 'b nil) ''abnil )
( (concat "a" "b" nil) ''abnil )
( (concat "a" "bcd" nil "ef" nil) ''abcdnilefnil )
( (concat "a" nil "b" ) ''anilb )
( (concat "a") ''a )
( (concat 'a) ''a )
( (concat 15 "hello" 15) ''15hello15 )
( (not(null(member '15hello15 (oblist)))) t )
( (uconcat) nil )
( (uconcat nil) nil )
( (uconcat 'a 'b nil) ''abnil )
( (uconcat "a" "b" nil) ''abnil )
( (uconcat "a" "bcd" nil "ef" nil) ''abcdnilefnil )
( (uconcat "a" nil "b" ) ''anilb )
( (uconcat "a") ''a )
( (uconcat 'a) ''a )
( (atom (setq z (uconcat 16 "hello" 16))) t )
( (not (member z (oblist))) t )
( (atom (setq z (gensym 'hi))) t )
( (not (member z (oblist))) t )
( (atom (intern z)) t )
( (not(not(member z (oblist)))) t )
( (atom (remob z)) t )
( (not(member z (oblist))) t )
( (atom (remob 'xyz)) t )
( (atom (setq z (maknam '(x y z)))) t )
( (eq z 'xyz) nil )
( (atom (remob 'xyz)) t )
( (atom (intern z)) t )
( (eq z (concat 'x 'y 'z)) t )
( (sort '(e d c b a) nil) ''(a b c d e) )
( (sort '(a b c d e) '(lambda(x y)(not(alphalessp x y)))) ''(e d c b a))
( (sort '(1 2 3 4 5) '<) ''(1 2 3 4 5) )
( (sort '(1 2 3 4 5) '>) ''(5 4 3 2 1) )
( (sortcar '((1 x)(2 y)) '>) ''((2 y)(1 x)) )
)
)
(setq List#4_File_IO_Functions
'( ( (portp (setq pp (fileopen 'junk 'w))) t )
( (print Data_1 pp) 'Data_1 )
( (print Data_1 pp) 'Data_1 )
( (patom Data_1 pp) 'Data_1 )
( (close pp) t )
( (portp (setq pp (fileopen 'junk 'r))) t )
( (read pp) 'Data_1 )
( (read pp) 'Data_1 )
( (read pp) 'Data_1 )
( (read pp 'at-end) ''at-end )
( (read pp) nil )
( (close pp) t )
( (portp (setq pp (fileopen 'junk 'r))) t )
( (readc pp) ''|(| )
( (readc pp) ''|a| )
( (readc pp) ''| | )
( (readc pp) ''|(| )
( (readc pp) ''|b| )
( (car (read pp)) ''c )
( (close pp) t )
( (portp (setq pp (fileopen 'junk 'w))) t )
( (patom '|8| pp) ''|8| )
( (princ '|8| pp) t )
( (close pp) t )
( (portp (setq pp (fileopen 'junk 'r))) t )
( (read pp) 88 )
( (readstr "a") ''a )
( (readstr "(a)") ''(a) )
( (readstr "(a b)") ''(a b) )
( (readstr "'(a b)") '''(a b) )
( (readstr "(a b" "c d)") ''(a b c d) )
( (readstr "(a b" "1 d)") ''(a b 1 d) )
( (readstr "(a b" "1.0 d)") ''(a b 1.0 d) )
( (readstr) nil )
( (readstr "" ) nil )
( (readstr " " " ") nil )
( (readstr "1.2e10") 1.2e10 )
( (readlist) nil )
( (readlist '(a)) ''a )
( (readlist '("(a b c" "d e f)")) ''(a b cd e f) )
( (close pp) t )
( (flatc nil) 3 )
( (flatsize nil) 3 )
( (flatc '|a b|) 3 )
( (flatsize '|a b|) 5 )
( (flatsize Data_2) 73 )
( (flatsize Data_2 10) 13 )
( (flatc Data_2) 71 )
( (flatc Data_2 10) 13 )
( (null (setq Old_pp (getd 'pp))) nil )
( (pp (F junk) pp) t )
( (cdr (boundp '$ldprint)) t )
( (setq $ldprint nil) nil )
( (load 'junk) t )
( (setq $ldprint t) t )
( (equal (getd 'pp) Old_pp) t )
( (sys:unlink 'junk) 0 )
;
; NOTE FILEPOS tests are missing.
;
)
)
;;
(setq List#5_Side_Effects
'(
( (eval '(car '(a b c))) ''a )
( (apply 'car '((a b c))) ''a )
( (funcall 'cons 'a '(b c)) ''(a b c) )
( (mapcar 'atom '(a (b) (c))) ''(t nil nil) )
( (mapc 'atom '(a (b) (c))) ''(a(b)(c)) )
( (maplist 'cons '(a b) '(x y)) ''(((a b) x y)((b)y)) )
( (map 'cons '(a b) '(x y)) ''(a b) )
( (def first (lambda(x)(car x))) ''first )
( (apply 'first '((a b c))) ''a )
( (funcall 'first '(a b c)) ''a )
( (def second(lambda(x)(first(cdr x)))) ''second )
( (def pluss(nlambda(l)(eval(cons '+ l)))) ''pluss )
( (apply 'pluss '(1 2 3)) ''6 )
( (funcall 'pluss 1 2 3) ''6 )
( (def firstm (macro(l)(cons 'car (cdr l)))) ''firstm )
( (def ttest(lexpr(n)(cons(arg 1)(cons n (listify 1))))) ''ttest )
( (def tj(lambda(a &optional b (c 3) &rest d &aux e (f 4))
(list a b c d e f))) ''tj )
( (car (setq a (getd 'first))) ''lambda )
( (car (setq b (getd 'second))) ''lambda )
( (car (setq c (getd 'pluss))) ''nlambda )
( (car (setq d (getd 'firstm))) ''macro )
( (car (setq e (getd 'ttest))) ''lexpr )
( (car (setq f (getd 'tj ))) ''lexpr )
( (defun first(x)(car x)) ''first )
( (defun second(x)(first(cdr x))) ''second )
( (defun pluss fexpr(l)(eval(cons '+ l))) ''pluss )
( (defun firstm macro(l)(cons 'car (cdr l))) ''firstm )
( (defun ttest n (cons (arg 1) (cons n (listify 1)))) ''ttest )
( (defun ttj(a &optional b (c 3) &rest d &aux e (f 4))
(list a b c d e f)) ''ttj )
( (equal (getd 'first) a) t )
( (equal (getd 'second) b) t )
( (equal (getd 'pluss) c) t )
( (equal (getd 'firstm) d) t )
( (equal (getd 'ttest) e) t )
( (equal (getd 'ttj) f) t )
( (ttj 'a) ''(a nil 3 nil nil 4) )
( (ttj 'a 'b) ''(a b 3 nil nil 4) )
( (ttj 'a 'b 'c) ''(a b c nil nil 4) )
( (ttj 'a 'b 'c 'd) ''(a b c (d) nil 4) )
( (first '(a b c)) ''a )
( (second '(a b c)) ''b )
( (pluss (+ 1 1) 3 3) 8 )
( (setq displace-macros nil) nil )
( (listp (setq x '(firstm '(a b c)))) t )
( (eval x) ''a )
( (equal x '(firstm '(a b c))) t )
( (macroexpand '(firstm '(a b c))) ''(car '(a b c)) )
( (setq displace-macros t) t )
( (eval x) ''a )
( (equal x '(car '(a b c))) t )
( (ttest 'a 'b 'c) ''(a 3 a b c) )
( (ttest 1 2 3 4 5) ''(1 5 1 2 3 4 5) )
( (fixp (setq free%cons (car (memstat)))) t )
( (fixp (setq oldcount $gccount$)) t )
( (gc) t )
( (= (+ oldcount 1) $gccount$) t )
( (< (car (memstat)) free%cons) t )
( (listp (setq oldlist (oblist))) t )
( (atom (setq temp (intern(gensym)))) t )
( (AtomInList? temp oldlist) nil )
( (AtomInList? temp (oblist)) t )
( (car (explode (gensym))) ''g )
( (car (explode (gensym "X"))) ''X )
( (car (explode (gensym 'Y))) ''Y )
)
)
(setq List#6_Destructives
'( ( (listp (setq L '(x y 1))) t )
( (attach 'a L) ''(a x y 1) )
( (attach nil L) ''(nil a x y 1) )
( (equal L '(nil a x y 1)) t )
( (delq 1 L) ''(nil a x y) )
( (equal L '(nil a x y)) t )
( (listp (setq L '("a" "a" "b" "a" "c" "a" "d"))) t )
( (delete "a" L 2) ''("b" "a" "c" "a" "d") )
( (listp (setq L '("a" "a" "b" "a" "c" "a" "d"))) t )
( (delq "a" L 2) ''("a" "a" "b" "a" "c" "a" "d") )
( (listp (setq L '(x a b c))) t )
( (delete 'a L) ''(x b c) )
( (delete 'b L) ''(x c) )
( (delete 'c L) ''(x) )
( (delete 'x L) nil )
( (hunksize (hunk 'a)) 1 )
( (hunksize (hunk "a" "b" "c" "d" "e")) 5 )
( (hunksize (makhunk 120)) 120 )
( (hunksize (makhunk '(1 2 3 4 5))) 5 )
( (hunkp (setq H (hunk 1 2 3 4 5 6 7 8 9 10))) t )
( (hunkp (setq I (hunk 1))) t )
( (hunk-to-list H) ''(1 2 3 4 5 6 7 8 9 10) )
( (hunk-to-list I) ''(1) )
( (cxr 0 I) 1 )
( (cxr 0 H) 1 )
( (cxr 9 H) 10 )
( (hunkp (rplacx 9 H "end")) t )
( (hunkp (rplacx 0 H "start")) t )
( (equal H (hunk "start" 2 3 4 5 6 7 8 9 "end")) t )
( (listp (setq X (copy '(a b c d)) Y X)) t )
( (eq X Y) t )
( (rplaca X 1) ''(1 b c d) )
( (eq X Y) t )
( (setq Z (copy X)) 'X )
( (rplacd X '(2 3)) ''(1 2 3) )
( (eq X Y) t )
( (eq X Z) nil )
)
)
(setq List#7_ControlFlow
'( ( (setq a 'A b 'B c 'C d 'D) ''D )
( (catch (throw 'x)) ''x )
( (catch (car (cdr (car (car (throw 'x)))))) ''x )
( (catch (car (throw 'x 'tag))) ''x )
( (catch (car (throw 'x 'tag)) 'tag) ''x )
( (catch (car (throw 'x 'tag)) '(tag1 tag2 tag3 tag)) ''x )
( (catch ((lambda(a b)(throw 'x)) nil nil)) ''x )
( (list a b) ''(A B) )
( (catch (prog (a b) c (throw 'x) d)) ''x )
( (list a b) ''(A B) )
( (catch ((nlambda(a)(throw 'x)) nil)) ''x )
( (list a b) ''(A B) )
( (catch ((macro(a)(throw 'x)) nil)) ''x )
( (list a b) ''(A B) )
( (catch ((lexpr(a)(throw 'x)) 1 2)) ''x )
( (list a b) ''(A B) )
( (errset (err 'x) nil) ''x )
( (sstatus chainatom t) t )
( (errset (car (cdr (car 8))) nil) ''(nil) )
( (sstatus chainatom nil) t )
( (errset (car (cdr (car 8))) nil) nil )
( (errset (car '(a b c))) ''(a) )
)
)
(setq List#8_Sets
'( ( (null (set-create '(nil nil nil))) t )
( (null (set-create nil)) t )
( (hunkp (setq s1 (set-create '(a (a) a ((a)))))) t )
( (hunkp (setq s2 (set-create '(a (a))))) t )
( (set-list s1) ''((a) a ((a))) )
( (set-list s2) ''((a) a) )
( (set-list (set-and s1)) ''((a) a ((a))) )
( (set-list (set-or s1)) ''((a) a ((a))) )
( (set-list (set-diff s1)) ''((a) a ((a))) )
( (set-list (set-and s1 s1)) ''((a) a ((a))) )
( (set-list (set-or s1 s1)) ''((a) a ((a))) )
( (set-list (set-diff s1 s1)) nil )
( (set-list (set-and s1 '(a))) ''(a) )
( (set-list (set-and s1 s2)) ''((a) a) )
( (set-list (set-or s1 '(b))) ''((a) b a ((a))) )
( (set-list (set-or s1 s2)) ''((a) a ((a))) )
( (set-list (set-diff s1 s2)) ''(((a))) )
( (set-list (set-or '(a) '(b) '(c) nil)) ''(c b a) )
( (set-list (set-or '(a b) '(b a) '(c b a))) ''(c b a) )
( (set-list (set-and '(a) '(b) '(c))) nil )
( (set-list (set-and '(a) '(a) '(a))) ''(a) )
( (set-list (set-and '(a b) '(b a) '(c b a))) ''(b a) )
( (set-list (set-and '(a b) nil '(c b a))) nil )
( (set-list (set-diff '(a b) '(b a) '(c b a))) nil )
( (set-list (set-diff '(a b) '(b))) ''(a) )
( (set-list (set-diff nil '(b))) nil )
( (set-member (set-create (oblist)) 'set-create) t )
)
)
;; Some data lists that are used by some of the test routines.
;; Do not change them as their contents are important to test results.
(setq Data_1 '(a(b(c(d(e(f(g)))(h)(((((i)(((j)((k))(l]
(setq Data_2 '(a(b(c(d(e(f('|g xx|)))(h . hi)(((((22)(((j)((k))(l]
(array Data_Array t 5 20)
(array Data_Array2 t 5 20)
(setq Hunk_126 (makhunk 126))
(setq Hunk_50 (makhunk 50))
(setq Hunk_1 (makhunk 1))
;; Function AtomInList?(a l)
;; ~~~~~~~~~~~~~~~~~~~~~~~~~
;; Look through list l for atom a. If found return true else return nil.
(defun AtomInList?(a l)
(prog ()
LOOP: (and (null l) (return nil))
(and (eq (car l) a) (return t))
(setq l (cdr l))
(go LOOP:)
)
)
;; Function Nearly Equal(a b)
;; ~~~~~~~~~~~~~~~~~~~~~~~~~~
;; Returns t if a and b are both numbers that are pretty close to each
;; other. The tolerance is .00001 just to give an idea that things are ok.
(defun NearlyEqual(a b)
(cond ((or (not (numbp a)) (not (numbp b))) nil)
((greaterp 0.00001 (abs (difference a b))) t)
(t nil)
)
)
;; Function run(tracing)
;; ~~~~~~~~~~~~~~~~~~~~~~
;; Initiate one q&a test - trace if 'tracing' is non nil. This test can
;; only be run once because of the expected side effects.
;;
(defun run(tracing)
(prog (where)
(setq where poport)
(Q&A List#1_Math_Functions where tracing)
(Q&A List#2_Predicates where tracing)
(Q&A List#3_Selectors_Creators where tracing)
(Q&A List#4_File_IO_Functions where tracing)
(Q&A List#5_Side_Effects where tracing)
(Q&A List#6_Destructives where tracing)
(Q&A List#7_ControlFlow where tracing)
(Q&A List#8_Sets where tracing)
(return t)
)
)
