;;
;;(C) Copyright Peter J.Ashwood-Smith 1981, 1991
;; 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 o.k. 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'. This test never ends, rather it repeatedly
;; uses more and more memory testing the garbage collector and compactor
;; in the process until it runs into the maximum block limit or until
;; it runs right out of memory.

(defun Q&A(ListOfTests where tracing)
       (prog (input result wwanted)
	     (and tracing
	         (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)))
                     (setq error_count (1+ error_count))
		     (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:)
       )
)

;
; compiler Q&A takes the same list of tests as above function Q&A but instead
; creates a (prog () (setq result <test>)
;                    (setq wwanted <result>)
;                    (or (NearlyEqual result wwanted)
;                        (setq error_count (1+ error_count))
;                        (printf "compiled code failed, input/expected and actual follow\n")
;                        (patom input)
;                        (patom "\n")
;                        (patom wwanted)
;                        (patom "\n")
;                        (patom result)
;                        (patom "\n")
;                    )
;
;           )
;
(load 'if.l)
(defun cQ&A(ListOfTests where tracing)
       (setq body nil)
       (and tracing (fprintf where "=============== NEXT COMPILED SUIT ================\n"))
       (foreach test (reverse ListOfTests)
                (setq body (cons  `(if (not (or (equal result wwanted) (NearlyEqual result wwanted))) then
                                       (setq error_count (1+ error_count))
                                       (fprintf ,where "compiled code failed, input/expected and actual follow\n")
                                       (pp-form (quote ,(car test)) ,where)
                                       (pp-form wwanted ,where)
                                       (pp-form result ,where)
                                   ) body ))
                (setq body (cons `(setq wwanted (eval ,(cadr test))) body ))
                (setq body (cons `(setq result ,(copy (car test))) body ))
                (and tracing (setq body (cons `(pp-form (quote ,(car test)) ,where) body )))
       )
       (setq body `(prog (result wanted) ,@body))
       (setq code (compile body))
       (setq code (car (ph-optimize code)))
       (setq code (assemble code))
       (eval code)
)

;; 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       )
      (  (boole 0)                                                  0       )
      ;  x and y
      (  (boole 1 0 0)                                              0       )
      (  (boole 1 1 0)                                              0       )
      (  (boole 1 0 1)                                              0       )
      (  (boole 1 1 1)                                              1       )
      ; ~x and y
      (  (boole 2 0 0)                                              0       )
      (  (boole 2 1 0)                                              0       )
      (  (boole 2 0 1)                                              1       )
      (  (boole 2 1 1)                                              0       )
      ; y
      (  (boole 3 9 10)                                             10      )
      ;  x and ~y
      (  (boole 4 0 0)                                              0       )
      (  (boole 4 1 0)                                              1       )
      (  (boole 4 0 1)                                              0       )
      (  (boole 4 1 1)                                              0       )
      ; x
      (  (boole 5 9)                                                9       )
      ;  x xor y
      (  (boole 6 0 0)                                              0       )
      (  (boole 6 1 0)                                              1       )
      (  (boole 6 0 1)                                              1       )
      (  (boole 6 1 1)                                              0       )
      ;  x or y
      (  (boole 7 0 0)                                              0       )
      (  (boole 7 1 0)                                              1       )
      (  (boole 7 0 1)                                              1       )
      (  (boole 7 1 1)                                              1       )
      ; ~( x or y )
      (  (boole 8 0 0)                                             -1       )
      (  (boole 8 1 0)                                             -2       )
      (  (boole 8 0 1)                                             -2       )
      (  (boole 8 1 1)                                             -2       )
      ; ~(x xor y)
      (  (boole 9 0 0)                                             -1       )
      (  (boole 9 1 0)                                             -2       )
      (  (boole 9 0 1)                                             -2       )
      (  (boole 9 1 1)                                             -1       )
      ; ~x
      (  (boole 10 1)                                              -2       )
      ; ~x or y
      (  (boole 11 0 0)                                            -1       )
      (  (boole 11 1 0)                                            -2       )
      (  (boole 11 0 1)                                            -1       )
      (  (boole 11 1 1)                                            -1       )
      ; ~y
      (  (boole 12 1 0)                                            -1       )
      ; x or ~y
      (  (boole 13 0 0)                                            -1       )
      (  (boole 13 1 0)                                            -1       )
      (  (boole 13 0 1)                                            -2       )
      (  (boole 13 1 1)                                            -1       )
      ; ~x or ~y
      (  (boole 14 0 0)                                            -1       )
      (  (boole 14 1 0)                                            -1       )
      (  (boole 14 0 1)                                            -1       )
      (  (boole 14 1 1)                                            -2       )
      ; -1
      (  (boole 15)                                                -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)) )
      (  (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) )
      (  (assoc 'a '(nil))                                          nil     )
      (  (assoc 'a '( (x y) nil (a b) ) )                        ''(a b)    )
      (  (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       )
      (  (flatten nil)                                            nil       )
      (  (flatten '(nil))                                         nil       )
      (  (flatten '(nil a b c))                                  ''(a b c ) )
      (  (flatten '(nil . a ))                                    ''a       )
      (  (flatten '(nil nil nil nil))                             nil       )
      (  (flatten '(a))                                           ''(a)     )
      (  (flatten '(a . b))                                      ''(a . b)  )
      (  (flatten '(((a)) . b))                                  ''(a . b)  )
      (  (flatten '(((a b) (c d)) e f nil g nil . b))  ''(a b c d e f g . b))
      (  (listp (setq x '(a b c d)))                               t        )
      (  (eq x (cdddr (flatten (append '((a)(b)(c)) x))))          t        )
      (  (listp (setq x '(a b . c)))                               t        )
      (  (eq x (flatten x))                                        t        )
      (  (flatten '([(((((a][(((((b]))                          ''(a b)     )
      (  (flatten '((nil a) (a nil) (a nil b)))                 ''(a a a b) )
      (  (flatten '((nil nil) (nil nil) (nil nil b)))           ''(b)       )
      (  (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))        )
      (  (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))                                         ''(a . 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)               "m"                 )
      (  (substring "abcdefghijklm" 12 2)               "lm"                )
      (  (substring 'abcdefghijklm  -1 1)               "m"                 )
      (  (substring "abcdefghijklm" -2)                 "lm"                )
      (  (substring 'abcdefghijklm  -30)                nil                 )
      (  (substring "abcdefghijklm" 10 40)              "jklm"              )
      (  (strsetpat "*xyz*")                             t                  )
      (  (strfndpat "abcdxyzklm")                        t                  )
      (  (strfndpat "abcdefgxy")                        nil                 )
      (  (strsetpat "x")                                 t                  )
      (  (strfndpat "x")                                 t                  )
      (  (strfndpat "xx")                               nil                 )
      (  (strsetpat "x*")                                t                  )
      (  (strfndpat "x")                                 t                  )
      (  (strfndpat "xx")                                t                  )
      (  (strsetpat "")                                  t                  )
      (  (strfndpat "")                                  t                  )
      (  (strfndpat " ")                                nil                 )
      (  (strsetpat "abc.*" nil)                         t                  )
      (  (strfndpat "abc")                               t                  )
      (  (strfndpat "ab")                               nil                 )
      (  (strfndpat "abcde")                             t                  )
      (  (strsetpat "[a+b]*" nil)                        t                  )
      (  (strfndpat "ababababbbbaaa")                    t                  )
      (  (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                   )
      (  (strcomp "")                                    ""                  )
      (  (strcomp " a")                                  "a"                 )
      (  (strcomp "a ")                                  "a"                 )
      (  (strcomp "     ")                               ""                  )
      (  (strcomp "  a  ")                               "a"                 )
      (  (strlen  "")                                     0                  )
      (  (strlen  "a")                                    1                  )
      (  (strlen  "ab")                                   2                  )
      (  (strtrim  "")                                   ""                  )
      (  (strtrim  " ")                                  ""                  )
      (  (strtrim  "     ")                              ""                  )
      (  (strtrim  "     ")                              ""                  )
      (  (strtrim  "  a  ")                              "  a"               )
      (  (strpad   "" 0   )                              ""                  )
      (  (strpad   " " 0  )                              ""                  )
      (  (strpad   " " 2  )                              "  "                )
      (  (strpad   " " 3  )                              "   "               )
      (  (toupper  ""     )                              ""                  )
      (  (toupper  "a"    )                             "A"                  )
      (  (toupper  "aBc"  )                             "ABC"                )
      (  (tolower  ""     )                              ""                  )
      (  (tolower  "A"    )                             "a"                  )
      (  (tolower  "AbC"  )                             "abc"                )
   )
)

(setq List#4_File_IO_Functions
  '(  ( (portp (setq p (fileopen 'junk 'w)))                      t         )
      ( (print Data_1 p)                                         'Data_1    )
      ( (print Data_1 p )                                        'Data_1    )
      ( (patom Data_1 p )                                        'Data_1    )
      ( (close p )                                                t         )
      ( (portp (setq p  (fileopen 'junk 'r)))                     t         )
      ( (read p )                                                'Data_1    )
      ( (read p )                                                'Data_1    )
      ( (read p )                                                'Data_1    )
      ( (read p  'at-end)                                       ''at-end    )
      ( (read p )                                                 nil       )
      ( (close p )                                                t         )
      ( (portp (setq p  (fileopen 'junk 'r)))                     t         )
      ( (readc p )                                              ''|(|       )
      ( (readc p )                                              ''|a|       )
      ( (readc p )                                              ''| |       )
      ( (readc p )                                              ''|(|       )
      ( (readc p )                                              ''|b|       )
      ( (car (read p ))                                         ''c         )
      ( (close p )                                                t         )
      ( (portp (setq p  (fileopen 'junk 'w)))                     t         )
      ( (patom '|8| p )                                        ''|8|        )
      ( (princ '|8| p )                                           t         )
      ( (close p )                                                t         )
      ( (listp (filestat 'junk))                                  t         )
      ( (portp (setq p  (fileopen 'junk 'r)))                     t         )
      ( (read p )                                                 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 p )                                                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         )
      ( (declare (nlambda pp))                                    t         )
      ( (pp (F junk) pp)                                          t         )
      ( (null (setq Old_pp (getd 'pp)))                          nil        )
      ( (setq $ldprint nil)                                      nil        )
      ( (load 'junk)                                              t         )
      ( (setq $ldprint t)                                         t         )
      ( (equal (getd 'pp) Old_pp)                                 t         )
      ( (portp (setq p (fileopen 'junk 'w)))                      t         )
      ( (patom "\n" p)                                           "\n"       )
      ( (patom "line1\n" p)                                      "line1\n"  )
      ( (close p)                                                 t         )
      ( (portp (setq p (fileopen 'junk 'r)))                      t         )
      ( (readln p)                                               ""         )
      ( (readln p)                                               "line1"    )
      ( (readln p 'myeof)                                       ''myeof     )
      ( (close p)                                                 t         )
      ( (sys:unlink 'junk)                                        0         )
      ( (sprintf nil)                                           "nil"       )
      ( (sprintf "")                                             ""         )
      ( (sprintf "a")                                            "a"        )
      ( (sprintf "a %% b")                                    "a % b"       )
      ( (sprintf "%s" "")                                        ""         )
      ( (sprintf "%10s" "")                                  "          "   )
      ( (sprintf "%10s" "abc")                               "       abc"   )
      ( (sprintf "%-10s" "abc")                              "abc       "   )
      ( (sprintf "10=%d" 10)                                   "10=10"      )
      ( (sprintf "10=%05d" 10)                               "10=00010"     )
      ( (sprintf "10=%05x" 10)                               "10=0000a"     )
      ( (sprintf "x=%c" 'x)                                    "x=x"        )
      ( (sprintf "10=%5.5f" 20.2)                            "10=20.20000"  )
      ( (sprintf "10%%=%d%%,20=%s%%" 10 "20")           "10%=10%,20=20%"    )
      ( (portp (setq p (fileopen 'junk 'w)))                      t         )
      ( (fprintf p "(10 %d)\n" 20)                                t         )
      ( (fprintf p "(10 %d)\n" 30)                                t         )
      ( (close p )                                                t         )
      ( (portp (setq p (fileopen 'junk 'r)))                      t         )
      ( (read p)                                            ''(10 20)       )
      ( (read p)                                            ''(10 30)       )
      ( (read p 'eof)                                           ''eof       )
      ( (close p )                                                t         )
      ( (portp (setq p (fileopen 'junk 'r)))                      t         )
      ( (fscanf p "(%2d %2d)" )                             ''(10 20)       )
      ( (fscanf p "\n(" )                                        nil        )
      ( (fscanf p "%s %[^)]%c" )                        ''("10" "30" ")")   )
      ( (read p 'eof)                                           ''eof       )
      ( (close p )                                                t         )
;
;  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        )
      (  (or (equal (getd 'first) a)  (eq (type (getd 'first)) 'clisp))  t  )
      (  (or (equal (getd 'second) b) (eq (type (getd 'first)) 'clisp))  t  )
      (  (or (equal (getd 'pluss) c)  (eq (type (getd 'first)) 'clisp))  t  )
      (  (or (equal (getd 'firstm) d) (eq (type (getd 'first)) 'clisp))  t  )
      (  (or (equal (getd 'ttest)  e) (eq (type (getd 'first)) 'clisp))  t  )
      (  (or (equal (getd 'ttj) f)    (eq (type (getd 'first)) 'clisp))  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         )
      (  (putd 'check '(lambda() 4))                            ''check     )
      (  (errset (check))                                       ''(4)       )
      (  (putd 'check nil)                                      ''check     )
      (  (errset (check) nil)                                    nil        )
      (  (setq global_XX 10)                                    10          )
      (  (boundp 'global_XX)                              ''(nil . 10)      )
      (  (makunbound 'global_XX)                                 t          )
      (  (boundp 'global_XX)                                    nil         )
      (  (makunbound 'global_XX)                                nil         )
      (  (setplist 'fred '((a . 10) (b . 20)))      ''((a . 10) (b . 20))   )
      (  (plist 'fred)                              ''((a . 10) (b . 20))   )
      (  (get 'fred 'a)                                         10          )
      (  (get 'fred 'b)                                         20          )
      (  (get 'fred 'c)                                         nil         )
      (  (putprop 'fred 30 'c)                                  30          )
      (  (get 'fred 'c)                                         30          )
      (  (remprop 'fred 'c)                 ''((c . 30) (a . 10) (b . 20))  )
      (  (setplist 'fred nil)                                   nil         )
      (  (plist 'fred)                                          nil         )

      (  (prog (x)
               (setq x 0)
               (foreach i nil)
               (foreach i nil nil)
               (foreach i '(1) (setq x (+ x i)))
               (foreach i '(1 2 3) (setq x (+ x i)))
               (return x)
         )                                                      7           )

      ( (while nil)                                             nil         )
      ( (while nil nil)                                         nil         )
      ( (repeat 0)                                              nil         )
      ( (repeat 100 nil)                                        nil         )

      ( (prog(i)(setq i 0)(repeat 1 (setq i (1+ i)))(return i))       1     )
      ( (prog(i)(setq i 0)(repeat 10 (setq i (1+ i)))(return i))      10    )
      ( (prog(i)(setq i 0)(while (< i 10)(setq i (1+ i)))(return i))  10    )
      ( (prog(i)(setq i 0)(while (> i 10)(setq i (1+ i)))(return i))   0    )

      ( (caseq (length '(a b c))
               (1 nil)
               (2 nil)
               (3 t)
               (t nil)
        )                                                              t    )

      ( (caseq (length '(a b c d e))
               (1 nil)
               (2 nil)
               (3 nil)
               (t t)
        )                                                              t    )

      ( (caseq (length '(a b c d e))
               ((1 2 3) nil)
               (4 nil)
               ((5 6) t)
               (t nil)
        )                                                              t    )

      ( (caseq (eq 'a 10)
               (nil t)
               (t nil)
        )                                                              t    )

      ( (caseq (eq 'a 10)
               ((10 nil) t)
               (t nil)
        )                                                              t    )

      ( (caseq 'x
               ((y z) nil)
               ((k x) t)
        )                                                              t    )

      ( (caseq 'x
               ((y z) t)
               ((k l) t)
        )                                                              nil  )

      ( (prog (i j tot)
           (setq i 0 tot 0)
           (while (< i 100)
                  (setq j i)
                  (while (< j 100)
                         (setq j (+ 1 j))
                         (cond ((< 120 (+ i j))
                                (return)))
                         (setq tot (+ tot j))
                  )
                  (setq i (+ 1 i))
                  (setq tot (+ tot i))
           )
           (return tot)
        )                                                     203940       )

      ( (prog (x)
              (setq x 4)
              (cond (nil )
                    (t (setq x 5)
                       (return x)
                       (setq x 6)
                    )
              )
              (setq x 7)
        )                                                        5          )

      ( (prog (x)
              (setq x 4)
              (cond (nil )
                    (t (setq x 5)
                       (go bot:)
                       (setq x 6)
                    )
              )
              (setq x 7)
              (return x)
          bot:(return 8)
        )                                                        8          )

      ( (prog (x)
              (setq x 4)
              (caseq 'tag
                    (y nil)
                    (tag (setq x 5)
                         (return x)
                         (setq x 6)
                    )
              )
              (setq x 7)
        )                                                        5          )

      ( (prog (x)
              (setq x 4)
              (caseq 'tag
                    (y nil)
                    (tag (setq x 5)
                         (go bot:)
                         (setq x 6)
                    )
              )
              (setq x 7)
              (return x)
          bot:(return 8)
        )                                                        8          )

      ( (sleep 0)                                                t          )
      ( (sleep 1.0)                                              t          )
      ( (tilde-expand "")                                        ""         )
      ( (tilde-expand "a")                                       "a"        )
      ( (tilde-expand "~$$$XYZ")                                 nil        )
      ( (tilde-expand "~$$$XYZ/abc")                             nil        )
      ( (tilde-expand "~/")                     (get_pname (getenv "HOME")) )
      ( (tilde-expand "~/abc")  (get_pname (concat (getenv "HOME") "/abc")) )
      ( (tilde-expand (concat "~" (getenv "USER"))) (get_pname (getenv "HOME")) )
  )
)

(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         )
      (  (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)) )
      (  (nreverse nil)                                           nil       )
      (  (nreverse '(a))                                        ''(a)       )
      (  (nreverse '(a b))                                      ''(b a)     )
      (  (nreverse '(a b c d e))                            ''(e d c b a)   )
      (  (nreverse (nreverse '(a b c d e)))                 ''(a b c d e)   )
      (  (nreverse '((a b) nil c d))                   ''(d c nil (a b))    )
      (  (listp (setq L '(a b c)))                                t         )
      (  (nreverse L)                                      ''(c b a)        )
      (  (equal L '(a))                                           t         )
      (  (listp (setq L '(a b c)))                               t          )
      (  (dsubst 'a 'b L)                                    ''(a a c)      )
      (  (equal L '(a a c))                                      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#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)       )
      (  (printf "disembodied MACRO/THROW not checked\n")     t             )
 ;    (  (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 (eval '(car (cdr (car 8)))) nil)            ''(nil)        )
      (  (sstatus chainatom nil)                              t             )
      (  (errset (eval '(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-and  '(nil nil) '(nil nil))                       nil           )
      (  (set-or   '(nil nil) '(nil nil))                       nil           )
      (  (set-diff '(nil nil) '(nil nil))                       nil           )
      (  (set-member (set-create (oblist)) 'set-create)          t            )
   )
)

(setq List#9_Symtabs
  '(
      (  (hunkp (symtab-create nil))                    t)
      (  (symtab-size (symtab-create '((a . 1) (b . 2) ( (d e f) . g ) (b . 2) (a . 1) ( (d e f) . g )  )))     3                 )
      (  (symtab-list (symtab-create '((a . 1) (b . 2))))                                                      ''((b . 2) (a . 1)) )
      (  (symtab-list (symtab-add (symtab-create '((a . 1) (b . 2))) 'c 'e))                                   ''((c . e) (b . 2) (a . 1)))
      (  (symtab-list (symtab-add (symtab-create '((a . 1) (b . 2))) 'a 2))                                    nil)
      (  (symtab-remove (symtab-create '((a . 1) (b . 2))) 'x)                                                 nil)
      (  (symtab-remove (symtab-create '((a . 1) (b . 2))) 'a)                                                 ''(a . 1))
      (  (symtab-remove (symtab-create '((a . 1) (b . 2))) 'b)                                                 ''(b . 2))

      (  (symtab-member (setq s1 (symtab-create (pairlis (oblist) (oblist) nil))) 'symtab-create) ''(symtab-create . symtab-create)  )
      (  (symtab-size s1)   (length (oblist)))

      (  (foreach atom (mapcar 'car (symtab-list s1))
               (and (not (equal (symtab-member s1 atom) `(,atom . ,atom)))
                    (return t)
               )
         )
         nil
      )

      (  (foreach atom (mapcar 'car (symtab-list s1))
               (and (not (equal (symtab-remove s1 atom) `(,atom . ,atom)))
                    (return t)
               )
         )
         nil
      )

      (  (symtab-size s1)   0  )
      (  (symtab-list s1)  nil )

      (  (prog ()
            (setq s1 (symtab-create `( ( "first" . "first" ) )))
            (foreach atom (oblist)
                  (symtab-add s1 atom atom)
                  (and (not (equal (symtab-member s1 atom) `(,atom . ,atom)))
                       (return t)
                  )
            )
            (return nil)
         )
         nil
      )

      (  (foreach atom (mapcar 'car (symtab-list s1))
               (and (not (equal (symtab-remove s1 atom) `(,atom . ,atom)))
                    (return t)
               )
         )
         nil
      )

      (  (symtab-size s1)   0  )
      (  (symtab-list s1)  nil )
   )
)

(setq List#10_BinaryIO
  '(     ( (portp (setq fp (fileopen "bin" "wb")))                 t            )
         ( (listp (setq o1 '( a b 10.2 "hello" -1 "" 255 " " 256 "  " -255 -256 -2 100 10000 -10000 "jfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjfjjfjfjfjfjfjf"
		   (fjfjfjfjfjffffffffssssssfsfsfsfsfsfsfsfffssssffsfsffffffffffffjfjfjfjfjf t nil quote car cons xyz . cdr )
		   () ((((())))) ((((((10.2 . 4))))))
		 )))                                               t            )
         ( (b-write o1 fp)                                         t            )
         ( (arrayp (array o2 t 150))                               t            )
         ( (o2 'onetwentyeight 128)                         ''onetwentyeight    )
         ( (b-write o2 fp)                                         t            )
         ( (portp (setq o3 (fileopen "junk" "w+")))                t            )
         ( (listp (print (setq oo1 (list o1 o1 o1)) o3))           t            )
         ( (listp (print oo1 o3))                                  t            )
         ( (listp (print oo1 o3))                                  t            )
         ( (fixp (filepos o3 0))                                   t            )
         ( (b-write o3 fp)                                         t            )
         ( (close fp)                                              t            )
         ( (portp (setq fp (fileopen "bin" "rb")))                 t            )
         ( (equal o1 (car (b-read fp)))                            t            )
         ( (equal o2 (car (b-read fp)))                            t            )
         ( (portp (setq i3 (car (b-read fp))))                     t            )
         ( (equal (read i3) oo1)                                   t            )
         ( (equal (read i3) oo1)                                   t            )
         ( (equal (read i3) oo1)                                   t            )
         ( (close i3)                                              t            )
         ( (close fp)                                              t            )
   )
)

(defun SOCKETOPEN(addr port &optional time &aux fd)
        (repeat 20
            (cond (time (setq fd (socketopen addr port time)))
                  ( t   (setq fd (socketopen addr port))))
            (and fd (return fd))
            (sleep 0.5)
        )
)

(setq List#11_SocketIO
  '(    (  (portp (setq fp (fileopen "go.l" "w")))                 t            )
        (  (pp-form `(def SOCKETOPEN ,(getd 'SOCKETOPEN)) fp)      t            )
        (  (pp-form '(setq skt (SOCKETOPEN "*" 31270)) fp)         t            )
        (  (pp-form '(and skt (close skt)) fp)                     t            )
        (  (pp-form
               '(prog () (setq fp (SOCKETOPEN "*" 31274 60))
                         (and fp
                             (b-write (eval (car (b-read fp 10))) fp 10)
                         )
                         (exit)
                ) fp )                                             t            )
        (  (close fp)                                              t            )
        (  (zerop (exec "bash -c 'unsetenv CAD_PORT ; cbdslisp go.l' &"))    t   )
        (  (portp (setq skt (SOCKETOPEN "*" 31270 60)))            t            )
        (  (and (portp skt) (close skt))                           t            )
        (  (sleep 5)                                               t            )
        (  (portp (setq fp (SOCKETOPEN "*" 31274)))                t            )
        (  (b-write '(+ 1 2 3 4 5) fp 10)                          t            )
        (  (drain fp)                                              t            )
        (  (b-read fp 10)                                        ''(15)         )
        (  (close fp)                                              t            )
        (  (zerop (exec "CAD_PORT=31276; export CAD_PORT;cbdslisp __ &"))   t   )
        (  (sleep 5)                                               t            )
        (  (remote-do "*" 31276 '(+ 1 2 3))                     ''((6))         )
        (  (repeat 100 (remote-do "*" 31276 '(+ 1 2)))          ''((3))         )
        (  (remote-do "*" 31276 '(REP-socketopen 31278))        ''(nil)         )
        (  (remote-do "*" 31278 '(exit))                        ''(nil)         )
        (  (sys:unlink "go.l")                                      0           )
        (  (listp (setq r (*process "/usr/bin/dc" t t )))           t           )
        (  (and (portp (car r)) (portp (cadr r)) (fixp (caddr r)))  t           )
        (  (*select (car r) 1)                                     nil          )
        (  (fprintf (cadr r) "1 2 + p 3 4 * p\n")                   t           )
        (  (drain (cadr r))                                         t           )
        (  (*select (car r) 1)                                   (car r)        )
        (  (readln (car r))                                        "3"          )
        (  (*select (car r) 1)                                   (car r)        )
        (  (readln (car r))                                        "12"         )
        (  (*select (car r) 1)                                      nil         )
        (  (fprintf (cadr r) "2\n3\n+\np\nq\n")                     t           )
        (  (drain (cadr r))                                         t           )
        (  (*select (car r) 1)                                   (car r)        )
        (  (readln (car r))                                        "5"          )
        (  (*select (car r) 1)                                     nil          )
        (  (close (car r))                                          t           )
        (  (close (cadr r))                                         t           )
        (  (listp (setq r (*process "cbdslisp" t t )))              t           )
        (  (and (portp (car r)) (portp (cadr r)) (fixp (caddr r)))  t           )
        (  (stringp (readln (car r)))                               t           )
        (  (stringp (readln (car r)))                               t           )
        (  (close (car r))                                          t           )
        (  (close (cadr r))                                         t           )
        (  (listp (setq r (*process "ls -al" t t )))                t           )
        (  (and (portp (car r)) (portp (cadr r)) (fixp (caddr r)))  t           )
        (  (stringp (readln (car r)))                               t           )
        (  (close (car r))                                          t           )
        (  (close (cadr r))                                         t           )
   )
)

;;  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)
      )
)


; MakeListOf(n Object) - will return a list with the object Object
; repeated n times.

(defun MakeListOf(n Object)
       (cond ((= n 0) ())
	     (t (cons Object (MakeListOf (- n 1) Object)))
       )
)

(defun IncrementList(l)
       (cond ((< 126 (car l))(cons (car l) (IncrementList (cdr l))))
	     (t (cons (+ (car l) 1) (cdr l)))
       )
)

(defun MakeAsciiList(ListOfNumbers)
       (cond ((null ListOfNumbers) ())
	     (t (cons (ascii(car ListOfNumbers))
		      (MakeAsciiList (cdr ListOfNumbers))
		)
	     )
       )
)

(defun runMemoryTest2(Size count)
       (prog (NumberList NewAtom)
	     (setq NumberList (MakeListOf Size 33))
             (repeat count
	        (setq NewAtom (implode (MakeAsciiList NumberList)))
                (putprop NewAtom 'x 'y)  ; don't GC it
	        (setq NumberList (IncrementList NumberList))
	     )
       )
)

(defun runMemoryTest1(n)
       (prog (x)
	     (setq y (makhunk 126))
	     (setq x "abcdefghijklmnopqrstuvwxyz")
             (repeat n
	         (exploden x) (explode x) (exploden x)
	         (substring x 1) (substring x 2) (substring x 3)
	         (gensym x) (gensym x) (gensym x)
	         (setq y (makhunk (1+ (random 127))))
	         (array Z t (1+ (random 100)) (1+ (random 5)))
             )
       )
)

(defun runMemoryTest3(n)                        ; test really long strings and the heap compaction!
       (repeat n
           (setq var (intern (gensym)))
           (set var 'a)
           (repeat (+ 120 (random 903))
                (set var (concat (eval var) 'x))
           )
           (strlen (eval var)) (strcomp (eval var))
           (strpad (eval var) (- (strlen (eval var)) 1))
           (get_pname (eval var))
           (readstr (eval var))
           (set var nil)
       )
)

(defun TestArrayOfSize(n)
     (prog (A i)
	   (array A t n)
	   (setq i 0)
      loop (A i i)
	   (cond ((not (= (A i) i)) (return nil)))
	   (setq i (1+ i))
	   (cond ((= i n) (return t)))
	   (go loop)
     )
)

(defun runArrayTest(n count)
      (prog (m)
          (repeat count
	    (setq m (+ (random n) 2))
	    (cond ((null (TestArrayOfSize m))
                   (setq error_count (1+ error_count))
	           (prinf "Failed The Test of size %d\n" m)
                  )
            )
          )
      )
)

;
; Following is the Diff.l file without comments. We just use
; it to run d5th derivitive of (* x (ln (+ x a)))) with respect
; to x as one of our sanity checks of the memory manager.
;
(defun  D(e X &aux u v)
 (cond ((equal e X) 1)
       ((atom e) 0)
       (t (setq u (cadr e) v (caddr e))
	  (caseq (car e)
		 (ln `(/ ,(D u X) ,u))
		 (+  `(+ ,(D u X) ,(D v X)))
		 (-  `(- ,(D u X) ,(D v X)))
		 (*  `(+  (* ,(D u X) ,v) (* ,(D v X) ,u)))
		 (/  `(-  (/ ,(D u X) ,v)
			  (/ (* ,u ,(D v X)) (^ ,v 2))))
		 (^  `(* ,e  (+ (/ (* ,v ,(D u X)) ,u)
				   (* ,(D v X) (ln ,u)))))
		 (t (princ "ERROR") (exit)]

(setq displace-macros t)

(defmacro ?times(v e)
       `(and (eq (car ,e) '*) (member ,v ,e]

(defmacro ?plus(v e)
       `(and (eq (car ,e) '+) (member ,v ,e]
(defmacro ?power(v e)
       `(and (eq (car ,e) '^) (eq (caddr ,e) ,v]

(defun Fold(e)
       (cond ((atom e) e)
	     (t (setq e (cons (Fold (car e)) (Fold (cdr e))))
		(cond ((?times 0 e) 0)
		      ((?times 1 e) (cond ((eq (cadr e) 1) (caddr e))
					  (t (cadr e))))
		      ((?power 1 e) (cadr e))
		      ((?plus  0 e) (cond ((eq (cadr e) 0) (caddr e))
					  (t (cadr e))))
		      (t e]

(defun Differentiate(e x)
       (Fold (D e x)]


;;  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.
;;

(setq error_count 0)

(defun run(tracing &optional (N 1) &aux where)

     ;;  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))

	(setq where poport)
   	(cQ&A List#1_Math_Functions where tracing)
   	(Q&A List#1_Math_Functions where tracing)
   	(cQ&A List#2_Predicates where tracing)
   	(Q&A List#2_Predicates where tracing)
   	(cQ&A List#3_Selectors_Creators where tracing)
   	(Q&A List#3_Selectors_Creators where tracing)
	(cQ&A List#4_File_IO_Functions where tracing)
	(Q&A List#4_File_IO_Functions where tracing)
   	(cQ&A List#5_Side_Effects where tracing)
   	(Q&A List#5_Side_Effects where tracing)
   	(cQ&A List#6_Destructives where tracing)
   	(Q&A List#6_Destructives where tracing)

        (setq llll nil)
        (setq lc 0)
        (or (fixp N) (setq N 1))
        (repeat N

      	    (cQ&A List#7_ControlFlow where tracing)
      	    (Q&A List#7_ControlFlow where tracing)
            (cQ&A List#8_Sets where tracing)
            (Q&A List#8_Sets where tracing)
            (cQ&A List#9_Symtabs where tracing)
            (Q&A List#9_Symtabs where tracing)
       	    (cQ&A List#10_BinaryIO where tracing)
       	    (Q&A List#10_BinaryIO where tracing)
;       	    (cQ&A List#11_SocketIO where tracing)
;       	    (Q&A List#11_SocketIO where tracing)

            (runArrayTest 127 20)
            (runArrayTest 200 20)
            (runArrayTest 1000 5)
            (runMemoryTest1 100)
            (runMemoryTest2 200 100)
            (runMemoryTest3 20)

            (Q&A List#1_Math_Functions where tracing)
            (cQ&A List#1_Math_Functions where tracing)
   	    (Q&A List#2_Predicates where tracing)
   	    (cQ&A List#2_Predicates where tracing)
            (setq y '(* x (ln (+ x a))))
            (repeat 5
                (setq y (Differentiate y 'x))
            )
            (repeat 1000
                (setq llll (cons (get_pname (uconcat "abcdjdjdjdjdjdjdjdjdjdjdjdjdjdjdj")) llll))
            )
            (printf "loop %d done!\n" (setq lc (1+ lc)))
            (patom (memstat))
            (printf "\n")
            (drain)
        )
        error_count
)

(printf "run time = %f\n" (time-eval (setq error_count (run (boundp 'Trace) (readstr (caddr (command-line-args)))))))
(printf "gccount = %d memstat = " $gccount$)
(patom (memstat)) (terpri)
(printf "error_count = %d\n" error_count)
(setq $ldprint nil)
;(exit error_count)
(exit)


