760 lines
52 KiB
Common Lisp
760 lines
52 KiB
Common Lisp
;; 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)
|
|
)
|
|
)
|