home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / PCLISP30.ZIP / Q&A.L < prev    next >
Encoding:
Text File  |  1990-02-01  |  51.7 KB  |  760 lines
  1. ;; Q&A.L - quality assurance tests
  2. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  3. ;;     A set of calls and correct results to make sure that PC-LISP is
  4. ;; behaving itself. These are run after every change to the source to
  5. ;; make sure things are kosher. If a new function is added a set of 
  6. ;; tests should be added also. Test results are printed on file whose
  7. ;; open port is 'where'.
  8.  
  9. (defun Q&A(ListOfTests where tracing)
  10.        (prog (input result wwanted) 
  11.          (patom (ascii 10) where)   
  12.          (patom '|=============== NEXT TEST SUIT ================| where)   
  13.          (patom (ascii 10) where)
  14.     LAB: (cond ((null ListOfTests) (return t)))     
  15.          (setq input (caar ListOfTests) wanted (cadar ListOfTests))
  16.          (cond (tracing (patom input)(patom "\n")))
  17.          (setq wanted (eval wanted)) 
  18.          (setq result (eval input))
  19.          (setq wwanted (eval wanted))
  20.          (cond ((and (null (equal wwanted result))          
  21.              (null (NearlyEqual wwanted result)))
  22.              (patom "FAIL: Input, Expected and Actual :\n" where)
  23.              (patom input)
  24.              (patom "\n" where)   
  25.              (patom wwanted)
  26.              (patom "\n" where)   
  27.              (patom result)
  28.              (patom "\n" where)))
  29.          (setq ListOfTests (cdr ListOfTests))
  30.          (go LAB:)    
  31.        )
  32. )
  33.  
  34. ;; TEST OF MATH FUNCTIONS
  35. ;; ~~~~~~~~~~~~~~~~~~~~~~
  36. ;; Test the math functions to make sure they are producing sensible results.   
  37. ;; No precision tests, these were done before math library was added to PC-LISP
  38.  
  39. (setq List#1_Math_Functions
  40.   '(  (  (abs 5000)                                                 5000    )
  41.       (  (abs -5000)                                                5000    )
  42.       (  (acos (cos 1.0))                                           1.0     )
  43.       (  (asin (sin 1.0))                                           1.0     )
  44.       (  (acos (cos .45))                                           .45     )
  45.       (  (asin (sin .45))                                           .45     )
  46.       (  (sum (times (cos .45) (cos .45) )                    
  47.         (times (sin .45) (sin .45) ))                           1.0     )
  48.       (  (atan 1.0 1.0 )                                       .785398163   )
  49.       (  (atan .22 1.0 )                                       .216550305   )
  50.       (  (log 2.718281828)                                          1.0     )
  51.       (  (log (exp 10))                                             10      )
  52.       (  (expt 2 8)                                                256      )
  53.       (  (expt 3 6)                                         (* 3 3 3 3 3 3 ))
  54.       (  (expt 2.2 3.3)                         (exp (times 3.3 (log 2.2))) )
  55.       (  (fact 0)                                                   1       )
  56.       (  (fact 10)                                         (* 10 (fact 9))  )
  57.       (  (fact 5)                                          (* 5 4 3 2 1)    )
  58.       (  (log10 (* 10 10 10 10 10 10 10 10))                        8       )
  59.       (  (log10 1)                                                  0       )
  60.       (  (max)                                                      0       )
  61.       (  (min)                                                      0       )
  62.       (  (max 14)                                                   14      )
  63.       (  (min 14)                                                   14      )
  64.       (  (max 0 1 2 -3 10 -14 50 100 0 -10 -19)                     100     )
  65.       (  (min 0 1 2 -3 10 -14 50 100 0 -10 -13)                    -14      )
  66.       (  (mod 8 2)                                                  0       )
  67.       (  (mod 16 3)                                                 1       )
  68.       (  (mod -16 -3)                                              -1       )
  69.       (  (mod -16 3)                                               -1       )
  70.       (  (mod 16 -3)                                                1       )
  71.       (  (> 15 (random 15))                                         t       )
  72.       (  (> 1  (random 1))                                          t       )
  73.       (  (not (= (random) (random)))                                t       )
  74.       (  (sqrt (* 2345 2345))                                       2345    )
  75.       (  (sqrt 49)                                                  7       )
  76.       (  (sqrt 1)                                                   1       )
  77.       (  (*)                                                        1       )
  78.       (  (/)                                                        1       )
  79.       (  (+)                                                        0       )
  80.       (  (-)                                                        0       )
  81.       (  (* 5 4 3 2 1)                                           (fact 5)   )
  82.       (  (/ 1000 10 10 10)                                          1       )
  83.       (  (+ 1 2 3 4 5)                                              15      )
  84.       (  (- 10 1 2 3 1 2 1)                                         0       )
  85.       (  (add1 8)                                                   9       )
  86.       (  (add1 8.0)                                                 9.0     )
  87.       (  (sub1 8)                                                   7       )
  88.       (  (sub1 8.0)                                                 7.0     )
  89.       (  (times)                                                    1       )
  90.       (  (add)                                                      0       )
  91.       (  (diff)                                                     0       )
  92.       (  (quotient)                                                 1       )
  93.       (  (times 2.0)                                                2.0     )
  94.       (  (add 2.0)                                                  2.0     )
  95.       (  (diff 2.0)                                                 2.0     )
  96.       (  (quotient 2.0)                                             2.0     )
  97.       (  (add 2.2 2.2 2.2 2.2 2.2)                                  11      )
  98.       (  (diff 11 2.2 2.2 2.2 2.2 2.2)                              0       )
  99.       (  (times 1.0 2.0 3.0 4.0 5.0)                            (fact 5)    )
  100.       (  (quotient 8.0 2.0 2.0 2.0)                                 1       )
  101.       (  (oddp 10)                                                 nil      )
  102.       (  (oddp 0)                                                  nil      )
  103.       (  (oddp -10)                                                nil      )
  104.       (  (oddp 11)                                                  t       )
  105.       (  (evenp -11)                                               nil      )
  106.       (  (evenp 10)                                                 t       )
  107.       (  (evenp 0)                                                  t       )
  108.       (  (evenp -10)                                                t       )
  109.       (  (evenp 11)                                                nil      )
  110.       (  (evenp -11)                                               nil      )
  111.       (  (and (zerop 0) (zerop 0.0))                                t       )
  112.       (  (zerop 8)                                                 nil      )
  113.       (  (zerop -8.0)                                              nil      )
  114.       (  (minusp 0)                                                nil      )
  115.       (  (minusp 8.0)                                              nil      )
  116.       (  (minusp 8)                                                nil      )
  117.       (  (minusp -1.0)                                             t        )
  118.       (  (plusp  0)                                                nil      )
  119.       (  (plusp -8.0)                                              nil      )
  120.       (  (plusp -8)                                                nil      )
  121.       (  (plusp  1.0)                                              t        )
  122.       (  (< 0 0)                                                   nil      )     
  123.       (  (> 0 0)                                                   nil      )     
  124.       (  (= 0 0)                                                    t       )     
  125.       (  (< -10 10)                                                 t       )     
  126.       (  (> 10 -10)                                                 t       )     
  127.       (  (= -10 -10)                                                t       )
  128.       (  (< 10 -10)                                                nil      )       
  129.       (  (> -10 10)                                                nil      )
  130.       (  (1+ 0)                                                     1       )
  131.       (  (1- 0)                                                    -1       )
  132.       (  (1+ 100)                                                  101      )
  133.       (  (1- -100)                                                -101      )
  134.       (  (greaterp 1.0)                                            t        )
  135.       (  (lessp    1.0)                                            t        )
  136.       (  (greaterp 10.0 9.9 9.8 9 8.9)                             t        )
  137.       (  (lessp    1.0 2.0 3.0 3.9 4 5 6 7)                        t        )
  138.       (  (greaterp 10.0 9.9 9.8 9 9.0)                             nil      )
  139.       (  (lessp    1.0 2.0 3.0 4.0 4 5 6 7)                        nil      )
  140.       (  (fixp 10)                                                 t        )
  141.       (  (fixp -10.0)                                              nil      )
  142.       (  (fixp 'a)                                                 nil      )
  143.       (  (fixp '(a))                                               nil      )
  144.       (  (fixp poport)                                             nil      )
  145.       (  (fixp "no")                                               nil      )
  146.       (  (numberp 0)                                               t        )
  147.       (  (numberp 0.0)                                             t        )
  148.       (  (numberp 'a)                                              nil      )
  149.       (  (numberp '(a))                                            nil      )
  150.       (  (numberp poport)                                          nil      )
  151.       (  (numberp "no")                                            nil      )
  152.       (  (lsh 1 8)                                                 256      )
  153.       (  (lsh 256 -8)                                               1       )
  154.    )
  155. )
  156.  
  157. ;; TEST OF SIMPLE PREDICATE FUNCTIONS
  158. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  159. ;; T and Nil quality assurance tests. Make sure that they behave as they should
  160. ;; do. Note particularly that imploding and exploding of nil should produce the
  161. ;; nil atom/list. 
  162.  
  163. (setq List#2_Predicates
  164.   '(  (  (eq nil nil)                                               t       )
  165.       (  (eq 10 10)                                                 t       )
  166.       (  (eq 11 10)                                                 nil     )
  167.       (  (eq nil t)                                                 nil     )
  168.       (  (eq 'nil nil)                                              t       )
  169.       (  (eq "hi" "hi")                                             nil     )
  170.       (  (atom nil)                                                 t       )
  171.       (  (atom "hi")                                                t       )
  172.       (  (atom Hunk_126)                                            nil     )
  173.       (  (equal ''nil ''())                                         t       )
  174.       (  (equal '("hi") '("hi"))                                    t       )
  175.       (  (equal '(a . (b . (c . (d)))) '(a b c d))                  t       )
  176.       (  (equal Hunk_126 Hunk_126)                                  t       )
  177.       (  (eq    Hunk_126 Hunk_126)                                  t       )
  178.       (  (equal Hunk_50  Hunk_126)                                  nil     )
  179.       (  (eq    Hunk_50  Hunk_126)                                  nil     )
  180.       (  (atom t)                                                   t       )
  181.       (  (equal (explode nil) '(n i l))                             t       )
  182.       (  (eq (implode '(n i l)) nil)                                t       )
  183.       (  (eq (implode '("n" "i" "l")) nil)                          t       )
  184.       (  (eq nil t)                                                 nil     )  
  185.       (  (eq 'a 'a)                                                 t       )  
  186.       (  (eq 2.8 2.8)                                               nil     )  
  187.       (  (eq '(a b) '(a b))                                         nil     )  
  188.       (  (equal '(a b) '(a b))                                      t       )
  189.       (  (equal '((a)((b))) '((a)((b))) )                           t       )
  190.       (  (equal '((a)((d))) '((a)((b))) )                           nil     )
  191.       (  (eq Data_1 Data_1)                                         t       )
  192.       (  (equal Data_1 Data_1)                                      t       )
  193.       (  (equal (getd 'Data_Array) (getd 'Data_Array2))             t       )
  194.       (  (null nil)                                                 t       )
  195.       (  (not nil)                                                  t       )    
  196.       (  (null 'a)                                                  nil     )
  197.       (  (not 'a)                                                   nil     )
  198.       (  (not "a")                                                  nil     )
  199.       (  (alphalessp 'abc 'abd)                                     t       )
  200.       (  (alphalessp 'abd 'abc)                                     nil     )
  201.       (  (alphalessp 'abc 'abc)                                     nil     )
  202.       (  (alphalessp "abc" "abd")                                   t       )
  203.       (  (alphalessp 'abd "abc")                                    nil     )
  204.       (  (alphalessp "abc" 'abc)                                    nil     )
  205.       (  (arrayp (getd 'Data_Array))                                t       )
  206.       (  (arrayp 8)                                                 nil     )
  207.       (  (arrayp 8.8)                                               nil     )
  208.       (  (arrayp poport)                                            nil     )
  209.       (  (atom 'a)                                                  t       )
  210.       (  (atom 8)                                                   t       )
  211.       (  (atom Data_1)                                              nil     )
  212.       (  (atom poport)                                              t       )
  213.       (  (null (boundp 'poport))                                    nil     )
  214.       (  (boundp (gensym))                                          nil     )
  215.       (  (floatp 'a)                                                nil     )
  216.       (  (floatp 8.0)                                               t       )
  217.       (  (floatp 8  )                                               nil     )
  218.       (  (floatp '|800|)                                            nil     )
  219.       (  (floatp Data_1)                                            nil     )
  220.       (  (floatp poport)                                            nil     )
  221.       (  (floatp "hi")                                              nil     )
  222.       (  (floatp Hunk_1)                                            nil     )
  223.       (  (hunkp  'a)                                                nil     )
  224.       (  (hunkp  8)                                                 nil     )
  225.       (  (hunkp  '|800|)                                            nil     )
  226.       (  (hunkp  Data_1)                                            nil     )
  227.       (  (hunkp  poport)                                            nil     )
  228.       (  (hunkp  "hi")                                              nil     )
  229.       (  (hunkp  Hunk_1)                                            t       )
  230.       (  (listp  'a)                                                nil     )
  231.       (  (listp  8)                                                 nil     )
  232.       (  (listp  '|800|)                                            nil     )
  233.       (  (listp  Data_1)                                            t       )
  234.       (  (listp  poport)                                            nil     )
  235.       (  (listp  "hi")                                              nil     )
  236.       (  (listp  Hunk_1)                                            nil     )
  237.       (  (portp  'a)                                                nil     )
  238.       (  (portp  8)                                                 nil     )
  239.       (  (portp  '|800|)                                            nil     )
  240.       (  (portp  Data_1)                                            nil     )
  241.       (  (portp  poport)                                            t       )
  242.       (  (portp  "hi")                                              nil     )
  243.       (  (portp  Hunk_1)                                            nil     )
  244.       (  (stringp  'a)                                              nil     )
  245.       (  (stringp 8)                                                nil     )
  246.       (  (stringp '|800|)                                           nil     )
  247.       (  (stringp Data_1)                                           nil     )
  248.       (  (stringp poport)                                           nil     )
  249.       (  (stringp "hi")                                             t       )
  250.       (  (stringp Hunk_1)                                           nil     )
  251.       (  (and)                                                      t       )
  252.       (  (or)                                                       t       )      
  253.       (  (and t)                                                    t       )
  254.       (  (or t)                                                     t       )
  255.       (  (and t t)                                                  t       )
  256.       (  (and t nil)                                                nil     )
  257.       (  (or  t nil)                                                t       )
  258.       (  (or  nil nil nil nil t nil nil nil)                        t       )
  259.       (  (or  nil nil nil nil nil nil nil nil)                      nil     )
  260.       (  (setq x 1)                                                 1       )
  261.       (  (and (atom '(a)) (setq x 2))                               nil     )
  262.       (  (= x 2)                                                    nil     )
  263.       (  (or  (+ 2 2) (setq x 3))                                   4       )   
  264.       (  (= x 3)                                                    nil     )
  265.       (  (or nil (+ 3 4) nil)                                       7       )
  266.       (  (and (+ 2 2) (+ 2 3) t (+ 2 4))                            6       )
  267.    )                                     
  268. )
  269.  
  270. ;; TEST OF SELECTORS AND CREATORS
  271. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  272. ;; Check all functions that have no side effects that select part of a list
  273. ;; or atom, or that create a new list or atom for quality.
  274.  
  275. (setq List#3_Selectors_Creators 
  276.   '(  (  (append)                                                   nil     )
  277.       (  (append nil)                                               nil     )
  278.       (  (append nil nil nil)                                       nil     )
  279.       (  (append '(a) nil '(b))                                   ''(a b)   )
  280.       (  (append '(a b (g)) nil '(h(i)) '(j(k)))    ''(a b (g) h (i) j (k)) )
  281.       (  (nconc )                                                   nil     )
  282.       (  (nconc  nil)                                               nil     )
  283.       (  (nconc  nil nil nil)                                       nil     )
  284.       (  (nconc  '(a) nil '(b))                                   ''(a b)   )
  285.       (  (nconc  '(a b (g)) nil '(h(i)) '(j(k)))    ''(a b (g) h (i) j (k)) )
  286.       (  (ascii 97)                                                ''a      )
  287.       (  (ascii 126)                                               ''|~|    )
  288.       (  (assoc 'a nil)                                             nil     )
  289.       (  (assoc nil nil)                                            nil     )
  290.       (  (assoc 'a '((a . b) (c . d) (e . f)))                    ''(a . b) ) 
  291.       (  (assoc 'x '((a . b) (c . d) (e . f)))                      nil     ) 
  292.       (  (assoc '(e) '((a . b) (c . d) ((e) . f)))              ''((e) . f) ) 
  293.       (  (car nil)                                                  nil     )
  294.       (  (cdr nil)                                                  nil     )
  295.       (  (cdr '(a))                                                 nil     )
  296.       (  (cdr '(a . b))                                            ''b      )
  297.       (  (cdr '(a b c))                                            ''(b c)  )
  298.       (  (car '(a))                                                ''a      )
  299.       (  (car '(a . b))                                            ''a      )
  300.       (  (car '((a)))                                              ''(a)    )
  301.       (  (caaar '(( (a) xx ) xx ) )                                ''a      )
  302.       (  (cdddr '(a b c d e) )                                     ''(d e)  )
  303.       (  (cadddr '(a b c d e xx xx ))                              ''d      )
  304.       (  (cons 'a nil)                                             ''(a)    )
  305.       (  (cons 'a 'nil)                                            ''(a)    )
  306.       (  (cons 'a 'b)                                              ''(a . b))
  307.       (  (cons 'a '(b c))                                          ''(a b c))
  308.       (  (cons '(a) 'b)                                         ''((a) . b) )
  309.       (  (cons nil nil)                                            ''(nil)  )
  310.       (  (explode nil)                                           ''(n i l)  )
  311.       (  (explode 'a)                                            ''(a)      )
  312.       (  (explode 'abcdefg)                                ''(a b c d e f g))     
  313.       (  (explode "abcdefg")                               ''(a b c d e f g))     
  314.       (  (explode 987)                                     ''(|9| |8| |7|)  )     
  315.       (  (exploden nil)                                    ''(110 105 108)  )
  316.       (  (exploden 'abc)                                   ''(97 98 99)     )
  317.       (  (exploden "abc")                                  ''(97 98 99)     )
  318.       (  (eq 'a (implode (explode 'a)))                             t       )
  319.       (  (eq 'abcd (implode (explode 'abcd)))                       t       )
  320.       (  (eq nil (implode (explode nil)))                           t       )
  321.       (  (length nil)                                               0       )
  322.       (  (length '(a))                                              1       )
  323.       (  (length '((a)))                                            1       )
  324.       (  (length '(a b c d))                                        4       )
  325.       (  (ldiff nil nil)                                           nil      )
  326.       (  (ldiff '(a b c) nil)                                    ''(a b c)  )
  327.       (  (ldiff '(a b c) '(a))                                   ''(b c)    )
  328.       (  (ldiff '(a b c 1 2) '(a b c 1 2))                         nil      )
  329.       (  (ldiff '("a" "b" "c") '("a" "b" "c"))          ''("a" "b" "c")     )
  330.       (  (list)                                                    nil      )
  331.       (  (list 'a)                                                ''(a)     )
  332.       (  (list 'a 'b 'c)                                      ''(a b c)     )
  333.       (  (list 'a '(b) 'c)                                    ''(a(b)c)     )
  334.       (  (list nil nil nil nil nil)                 ''(nil nil nil nil nil) )
  335.       (  (member 'a '(x y z a b c))                           ''(a b c)     )
  336.       (  (memq   'a '(x y z a b c))                           ''(a b c)     )
  337.       (  (member 'k '(x y z a b c))                                nil      )
  338.       (  (memq   'k '(x y z a b c))                                nil      )
  339.       (  (member '(a b) '(x y z (a b) c))                    ''((a b) c)    )
  340.       (  (memq   '(a b) '(x y z (a b) c))                          nil      )
  341.       (  (listp (setq z '((a b) (c d) e)))                          t       )
  342.       (  (memq  (cadr z) z)                                  ''((c d) e)    )
  343.       (  (nth 0 nil)                                               nil      )
  344.       (  (nth 10 nil)                                              nil      )
  345.       (  (nth -10 nil)                                             nil      )
  346.       (  (nth 0  '((a)b c d))                                   ''(a)       )
  347.       (  (nth 3 '(a b c d))                                       ''d       )
  348.       (  (nthchar nil 0)                                          nil       )
  349.       (  (nthchar nil 1)                                          ''n       )
  350.       (  (nthchar nil 3)                                          ''l       )
  351.       (  (nthchar 'abcde 3)                                       ''c       )
  352.       (  (nthchar "abcde" 1)                                      ''a       )
  353.       (  (nthchar 'abcde 5)                                       ''e       )
  354.       (  (nthchar 'abcde 6)                                       nil       )
  355.       (  (nthchar "abcde" -1)                                     nil       )
  356.       (  (pairlis '(a) '(b) nil)                          ''((a . b))       )
  357.       (  (pairlis '((a)) '((b)) nil)                      ''(((a) b))       )
  358.       (  (pairlis '(a c) '(d f) '(g h))          ''((a . d)(c . f) g h)     )
  359.       (  (quote nil)                                              nil       )
  360.       (  (quote a)                                              ''a         )
  361.       (  (quote (a b c))                                        ''(a b c)   )
  362.       (  (remove 'a '(a b c))                                   ''(b c)     )
  363.       (  (remove 'a '(a a b c) 1)                               ''(a b c)   )
  364.       (  (remove 'a nil 4)                                        nil       )
  365.       (  (remq   1  '(a a 1 c) 1)                               ''(a a c)   )
  366.       (  (remq  'a  '(a a 1 c) 1)                               ''(a 1 c)   )
  367.       (  (reverse nil)                                            nil       )
  368.       (  (reverse '(a))                                         ''(a)       )
  369.       (  (reverse '(a b))                                       ''(b a)     )
  370.       (  (reverse '(a b c d e))                             ''(e d c b a)   )
  371.       (  (reverse (reverse '(a b c d e)))                   ''(a b c d e)   )
  372.       (  (reverse '((a b) nil c d))                    ''(d c nil (a b))    )
  373.       (  (> 50 (sizeof 'symbol))                                  t         )
  374.       (  (> 50 (sizeof 'flonum))                                  t         )
  375.       (  (> 50 (sizeof 'port))                                    t         )
  376.       (  (> 50 (sizeof "fixnum"))                                 t         )
  377.       (  (> 50 (sizeof 'string))                                  t         )
  378.       (  (> 50 (sizeof "list"))                                   t         )
  379.       (  (> 50 (sizeof "array"))                                  t         )
  380.       (  (subst 'a 'b nil)                                       nil        )
  381.       (  (subst 'a 'b '(a . b))                                ''(a . a)    )
  382.       (  (subst 'a 'b '(a b a b))                           ''(a a a a)     )
  383.       (  (subst 'a '(1 2) '((1 2) (1 2) ((1 2))))        ''(a a (a))        )
  384.       (  (listp (setq L '(a b c)))                               t          )
  385.       (  (dsubst 'a 'b L)                                    ''(a a c)      )
  386.       (  (equal L '(a a c))                                      t          )
  387.       (  (memusage nil)                                           0         )
  388.       (  (memusage 'a)                            (+ 2 (sizeof 'symbol))    )
  389.       (  (memusage "a")                           (+ 2 (sizeof "string"))   )
  390.       (  (fixp (memusage (oblist)))                               t         )
  391.       (  (type nil)                                             ''list      )
  392.       (  (type t)                                               ''symbol    )
  393.       (  (type 8)                                               ''fixnum    )
  394.       (  (type '|8|)                                            ''symbol    )
  395.       (  (type poport)                                          ''port      )
  396.       (  (type "hi")                                            ''string    )
  397.       (  (type '(a b c))                                        ''list      )
  398.       (  (type (getd 'Data_Array))                              ''array     )  
  399.       (  (last nil)                                              nil        )
  400.       (  (last '(a))                                             ''a        )
  401.       (  (last '(a . b))                                         ''b        )
  402.       (  (last '(a b c (d e)))                                 ''(d e)      )
  403.       (  (nthcdr 10 nil)                                         nil        )
  404.       (  (nthcdr 0 '(a))                                       ''(a)        )
  405.       (  (nthcdr 1 '(a . b))                                     ''b        )
  406.       (  (nthcdr 3 '(a b c (d e)))                             ''((d e))    )
  407.       (  (nthcdr 2 '(a b c (d e)))                             ''(c(d e))   )
  408.       (  (nthcdr -1.0 '(a b))                               ''(nil a b)     )
  409.       (  (character-index 'abcde 'a)                             1          )
  410.       (  (character-index 'abcde 'b)                             2          )
  411.       (  (character-index 'abcde 'e)                             5          )
  412.       (  (character-index 'abcde 'x)                            nil         )
  413.       (  (character-index "abcde" "cde")                         3          )
  414.       (  (character-index "" "")                                nil         )
  415.       (  (get_pname 'junk)                                     "junk"       )
  416.       (  (get_pname "junk")                                    "junk"       )
  417.       (  (substring "abcdefghijklm" 0)                          nil         )
  418.       (  (substring "abcdefghijklm" 1)                  "abcdefghijklm"     )
  419.       (  (substring "abcdefghijklm" 1 1)                "a"                 )
  420.       (  (substring "abcdefghijklm" 3 3)                "cde"               )
  421.       (  (substring "abcdefghijklm" 13 1)               "m"                 )
  422.       (  (substring "abcdefghijklm" 13 2)               nil                 )
  423.       (  (substring "abcdefghijklm" 12 2)               "lm"                )
  424.       (  (substring 'abcdefghijklm  -1 1)               "m"                 )
  425.       (  (substring "abcdefghijklm" -2)                 "lm"                )
  426.       (  (substring 'abcdefghijklm  -30)                nil                 )
  427.       (  (substring "abcdefghijklm" 10 40)              nil                 )
  428.       (  (concat)                                       nil                 )
  429.       (  (concat nil)                                   nil                 )
  430.       (  (concat 'a 'b nil)                           ''abnil               )
  431.       (  (concat "a" "b" nil)                         ''abnil               )
  432.       (  (concat "a" "bcd" nil "ef" nil)              ''abcdnilefnil        )
  433.       (  (concat "a" nil "b" )                        ''anilb               )
  434.       (  (concat "a")                                 ''a                   )
  435.       (  (concat 'a)                                  ''a                   )
  436.       (  (concat 15 "hello" 15)                       ''15hello15           )
  437.       (  (not(null(member '15hello15 (oblist))))        t                   )
  438.       (  (uconcat)                                       nil                 )
  439.       (  (uconcat nil)                                   nil                 )
  440.       (  (uconcat 'a 'b nil)                           ''abnil               )
  441.       (  (uconcat "a" "b" nil)                         ''abnil               )
  442.       (  (uconcat "a" "bcd" nil "ef" nil)              ''abcdnilefnil        )
  443.       (  (uconcat "a" nil "b" )                        ''anilb               )
  444.       (  (uconcat "a")                                 ''a                   )
  445.       (  (uconcat 'a)                                  ''a                   )
  446.       (  (atom (setq z (uconcat 16 "hello" 16)))         t                   )
  447.       (  (not (member z (oblist)))                       t                   )
  448.       (  (atom (setq z (gensym 'hi)))                    t                   )
  449.       (  (not (member z (oblist)))                       t                   )   
  450.       (  (atom (intern z))                               t                   )
  451.       (  (not(not(member z (oblist))))                   t                   )
  452.       (  (atom (remob z))                                t                   )
  453.       (  (not(member z (oblist)))                        t                   )
  454.       (  (atom (remob 'xyz))                             t                   )
  455.       (  (atom (setq z (maknam '(x y z))))               t                   )
  456.       (  (eq z 'xyz)                                     nil                 )
  457.       (  (atom (remob 'xyz))                             t                   )
  458.       (  (atom (intern z))                               t                   )
  459.       (  (eq z (concat 'x 'y 'z))                        t                   )
  460.       (  (sort '(e d c b a) nil)                        ''(a b c d e)        )
  461.       (  (sort '(a b c d e) '(lambda(x y)(not(alphalessp x y)))) ''(e d c b a))
  462.       (  (sort '(1 2 3 4 5) '<)                         ''(1 2 3 4 5)        )
  463.       (  (sort '(1 2 3 4 5) '>)                         ''(5 4 3 2 1)        )
  464.       (  (sortcar '((1 x)(2 y)) '>)                     ''((2 y)(1 x))       )
  465.    )
  466. )
  467.  
  468. (setq List#4_File_IO_Functions 
  469.   '(  ( (portp (setq pp (fileopen 'junk 'w)))                     t         )
  470.       ( (print Data_1 pp)                                        'Data_1    )
  471.       ( (print Data_1 pp)                                        'Data_1    )
  472.       ( (patom Data_1 pp)                                        'Data_1    )
  473.       ( (close pp)                                                t         )
  474.       ( (portp (setq pp (fileopen 'junk 'r)))                     t         )
  475.       ( (read pp)                                                'Data_1    )
  476.       ( (read pp)                                                'Data_1    )
  477.       ( (read pp)                                                'Data_1    )
  478.       ( (read pp 'at-end)                                       ''at-end    )
  479.       ( (read pp)                                                 nil       )
  480.       ( (close pp)                                                t         )
  481.       ( (portp (setq pp (fileopen 'junk 'r)))                     t         )  
  482.       ( (readc pp)                                              ''|(|       )
  483.       ( (readc pp)                                              ''|a|       )
  484.       ( (readc pp)                                              ''| |       )
  485.       ( (readc pp)                                              ''|(|       )
  486.       ( (readc pp)                                              ''|b|       )
  487.       ( (car (read pp))                                         ''c         )
  488.       ( (close pp)                                                t         )
  489.       ( (portp (setq pp (fileopen 'junk 'w)))                     t         )
  490.       ( (patom '|8| pp)                                        ''|8|        )
  491.       ( (princ '|8| pp)                                           t         )
  492.       ( (close pp)                                                t         )
  493.       ( (portp (setq pp (fileopen 'junk 'r)))                     t         )
  494.       ( (read pp)                                                 88        )
  495.       ( (readstr "a")                                           ''a         )
  496.       ( (readstr "(a)")                                 ''(a)               )
  497.       ( (readstr "(a b)")                               ''(a b)             )
  498.       ( (readstr "'(a b)")                              '''(a b)            )
  499.       ( (readstr "(a b" "c d)")                         ''(a b c d)         )
  500.       ( (readstr "(a b" "1 d)")                         ''(a b 1 d)         )
  501.       ( (readstr "(a b" "1.0 d)")                       ''(a b 1.0 d)       )
  502.       ( (readstr)                                                nil        )
  503.       ( (readstr "" )                                            nil        )
  504.       ( (readstr " " " ")                                        nil        )
  505.       ( (readstr "1.2e10")                                     1.2e10       )
  506.       ( (readlist)                                               nil        )
  507.       ( (readlist '(a))                                        ''a          )
  508.       ( (readlist '("(a b c" "d e f)"))                   ''(a b cd e f)    )
  509.       ( (close pp)                                                t         ) 
  510.       ( (flatc nil)                                               3         )
  511.       ( (flatsize nil)                                            3         )
  512.       ( (flatc '|a b|)                                            3         )
  513.       ( (flatsize '|a b|)                                         5         )
  514.       ( (flatsize Data_2)                                        73         )
  515.       ( (flatsize Data_2 10)                                     13         )
  516.       ( (flatc    Data_2)                                        71         )
  517.       ( (flatc    Data_2 10)                                     13         )
  518.       ( (null (setq Old_pp (getd 'pp)))                          nil        )
  519.       ( (pp (F junk) pp)                                          t         )
  520.       ( (cdr (boundp '$ldprint))                                  t         )
  521.       ( (setq $ldprint nil)                                      nil        )
  522.       ( (load 'junk)                                              t         )      
  523.       ( (setq $ldprint t)                                         t         )
  524.       ( (equal (getd 'pp) Old_pp)                                 t         )
  525.       ( (sys:unlink 'junk)                                        0         )
  526. ;          
  527. ;  NOTE    FILEPOS tests are missing.
  528. ;          
  529.    )
  530. )
  531.  
  532. ;;
  533.  
  534. (setq List#5_Side_Effects
  535.   '( 
  536.       (  (eval '(car '(a b c)))                                 ''a         )
  537.       (  (apply 'car '((a b c)))                                ''a         )
  538.       (  (funcall 'cons 'a '(b c))                              ''(a b c)   )
  539.       (  (mapcar 'atom '(a (b) (c)))                         ''(t nil nil)  )
  540.       (  (mapc   'atom '(a (b) (c)))                            ''(a(b)(c)) )
  541.       (  (maplist 'cons '(a b) '(x y))                ''(((a b) x y)((b)y)) )
  542.       (  (map 'cons '(a b) '(x y))                              ''(a b)     )
  543.       (  (def first (lambda(x)(car x)))                         ''first     )
  544.       (  (apply 'first '((a b c)))                              ''a         )
  545.       (  (funcall 'first '(a b c))                              ''a         )
  546.       (  (def second(lambda(x)(first(cdr x))))                  ''second    )
  547.       (  (def pluss(nlambda(l)(eval(cons '+ l))))               ''pluss     )
  548.       (  (apply 'pluss '(1 2 3))                                ''6         )
  549.       (  (funcall 'pluss 1 2 3)                                 ''6         )
  550.       (  (def firstm (macro(l)(cons 'car (cdr l))))             ''firstm    )
  551.       (  (def ttest(lexpr(n)(cons(arg 1)(cons n (listify 1))))) ''ttest     )
  552.       (  (def tj(lambda(a &optional b (c 3) &rest d &aux e (f 4))
  553.          (list a b c d e f)))                           ''tj        )
  554.       (  (car (setq a (getd 'first)))                           ''lambda    )
  555.       (  (car (setq b (getd 'second)))                          ''lambda    )
  556.       (  (car (setq c (getd 'pluss)))                           ''nlambda   )
  557.       (  (car (setq d (getd 'firstm)))                          ''macro     )
  558.       (  (car (setq e (getd 'ttest)))                           ''lexpr     )
  559.       (  (car (setq f (getd 'tj   )))                           ''lexpr     )
  560.       (  (defun first(x)(car x))                                ''first     )
  561.       (  (defun second(x)(first(cdr x)))                        ''second    )
  562.       (  (defun pluss fexpr(l)(eval(cons '+ l)))                ''pluss     )
  563.       (  (defun firstm macro(l)(cons 'car (cdr l)))             ''firstm    )
  564.       (  (defun ttest n (cons (arg 1) (cons n (listify 1))))    ''ttest     )
  565.       (  (defun ttj(a &optional b (c 3) &rest d &aux e (f 4))
  566.          (list a b c d e f))                           ''ttj        )
  567.       (  (equal (getd 'first) a)                                t           )
  568.       (  (equal (getd 'second) b)                               t           )
  569.       (  (equal (getd 'pluss) c)                                t           )
  570.       (  (equal (getd 'firstm) d)                               t           )
  571.       (  (equal (getd 'ttest)  e)                               t           )
  572.       (  (equal (getd 'ttj) f)                                  t           )  
  573.       (  (ttj 'a)                                   ''(a nil 3 nil nil 4)   )
  574.       (  (ttj 'a 'b)                                ''(a b 3 nil nil 4)     )
  575.       (  (ttj 'a 'b 'c)                             ''(a b c nil nil 4)     )
  576.       (  (ttj 'a 'b 'c 'd)                          ''(a b c (d) nil 4)     )
  577.       (  (first '(a b c))                                       ''a         )
  578.       (  (second '(a b c))                                      ''b         )
  579.       (  (pluss (+ 1 1) 3 3)                                    8           )
  580.       (  (setq displace-macros nil)                             nil         )
  581.       (  (listp (setq x '(firstm '(a b c))))                    t           )
  582.       (  (eval x)                                               ''a         )
  583.       (  (equal x '(firstm '(a b c)))                           t           )
  584.       (  (macroexpand '(firstm '(a b c)))               ''(car '(a b c))    )
  585.       (  (setq displace-macros t)                               t           )
  586.       (  (eval x)                                               ''a         )
  587.       (  (equal x '(car '(a b c)))                              t           )     
  588.       (  (ttest 'a 'b 'c)                                   ''(a 3 a b c)   )
  589.       (  (ttest 1 2 3 4 5)                                ''(1 5 1 2 3 4 5) )
  590.       (  (fixp (setq free%cons (car (memstat))))                t           )
  591.       (  (fixp (setq oldcount $gccount$))                       t           )
  592.       (  (gc)                                                   t           )
  593.       (  (= (+ oldcount 1) $gccount$)                           t           )
  594.       (  (< (car (memstat)) free%cons)                          t           )
  595.       (  (listp (setq oldlist (oblist)))                        t           )
  596.       (  (atom (setq temp (intern(gensym))))                    t           )
  597.       (  (AtomInList? temp oldlist)                             nil         )
  598.       (  (AtomInList? temp (oblist))                            t           )
  599.       (  (car (explode (gensym)))                               ''g         )
  600.       (  (car (explode (gensym "X")))                           ''X         )
  601.       (  (car (explode (gensym 'Y)))                            ''Y         )
  602.    )
  603. )
  604.  
  605. (setq List#6_Destructives
  606.   '(  (  (listp (setq L '(x y 1)))                              t           )
  607.       (  (attach 'a L)                                      ''(a x y 1)     )
  608.       (  (attach nil L)                                     ''(nil a x y 1) )
  609.       (  (equal L '(nil a x y 1))                               t           )
  610.       (  (delq 1 L)                                         ''(nil a x y)   )
  611.       (  (equal L '(nil a x y))                                 t           )
  612.       (  (listp (setq L '("a" "a" "b" "a" "c" "a" "d")))        t           )
  613.       (  (delete "a" L 2)                         ''("b" "a" "c" "a" "d")   )
  614.       (  (listp (setq L '("a" "a" "b" "a" "c" "a" "d")))        t           )
  615.       (  (delq   "a" L 2)                 ''("a" "a" "b" "a" "c" "a" "d")   )
  616.       (  (listp (setq L '(x a b c)))                            t           )
  617.       (  (delete 'a L)                                     ''(x b c)        )
  618.       (  (delete 'b L)                                     ''(x c)          )
  619.       (  (delete 'c L)                                     ''(x)            )
  620.       (  (delete 'x L)                                         nil          )
  621.       (  (hunksize (hunk 'a))                                   1           )
  622.       (  (hunksize (hunk "a" "b" "c" "d" "e"))                  5           )
  623.       (  (hunksize (makhunk 120))                               120         )
  624.       (  (hunksize (makhunk '(1 2 3 4 5)))                      5           )
  625.       (  (hunkp (setq H (hunk 1 2 3 4 5 6 7 8 9 10)))           t           )
  626.       (  (hunkp (setq I (hunk 1)))                              t           )
  627.       (  (hunk-to-list H)                          ''(1 2 3 4 5 6 7 8 9 10) )
  628.       (  (hunk-to-list I)                          ''(1)                    )
  629.       (  (cxr 0 I)                                              1           )
  630.       (  (cxr 0 H)                                              1           )
  631.       (  (cxr 9 H)                                              10          )
  632.       (  (hunkp (rplacx 9 H "end"))                             t           )
  633.       (  (hunkp (rplacx 0 H "start"))                           t           )
  634.       (  (equal H (hunk "start" 2 3 4 5 6 7 8 9 "end"))         t           )
  635.       (  (listp (setq X (copy '(a b c d)) Y X))                 t           )
  636.       (  (eq X Y)                                               t           )
  637.       (  (rplaca X 1)                                      ''(1 b c d)      )
  638.       (  (eq X Y)                                               t           )
  639.       (  (setq Z (copy X))                                     'X           )
  640.       (  (rplacd X '(2 3))                                 ''(1 2 3)        )
  641.       (  (eq X Y)                                               t           )
  642.       (  (eq X Z)                                               nil         )
  643.    )
  644. )
  645.  
  646. (setq List#7_ControlFlow
  647.   '(  (  (setq a 'A b 'B c 'C d 'D)                            ''D          )
  648.       (  (catch (throw 'x))                                    ''x          )
  649.       (  (catch (car (cdr (car (car (throw 'x))))))            ''x          )
  650.       (  (catch (car (throw 'x 'tag)))                         ''x          )
  651.       (  (catch (car (throw 'x 'tag)) 'tag)                    ''x          )
  652.       (  (catch (car (throw 'x 'tag)) '(tag1 tag2 tag3 tag))   ''x          )
  653.       (  (catch ((lambda(a b)(throw 'x)) nil nil))             ''x          )
  654.       (  (list a b)                                           ''(A B)       )
  655.       (  (catch (prog (a b) c (throw 'x) d))                   ''x          )
  656.       (  (list a b)                                           ''(A B)       )
  657.       (  (catch ((nlambda(a)(throw 'x)) nil))                 ''x           )
  658.       (  (list a b)                                           ''(A B)       )
  659.       (  (catch ((macro(a)(throw 'x)) nil))                   ''x           )
  660.       (  (list a b)                                           ''(A B)       )
  661.       (  (catch ((lexpr(a)(throw 'x)) 1 2))                   ''x           )
  662.       (  (list a b)                                           ''(A B)       )
  663.       (  (errset (err 'x) nil)                                ''x           )
  664.       (  (sstatus chainatom t)                                t             )
  665.       (  (errset (car (cdr (car 8))) nil)                    ''(nil)        )
  666.       (  (sstatus chainatom nil)                              t             )
  667.       (  (errset (car (cdr (car 8))) nil)                     nil           )
  668.       (  (errset (car '(a b c)))                              ''(a)         )
  669.    )
  670. )
  671.  
  672. (setq List#8_Sets        
  673.   '(  (  (null (set-create '(nil nil nil)))                      t            )
  674.       (  (null (set-create nil))                                 t            )
  675.       (  (hunkp (setq s1 (set-create '(a (a) a ((a))))))         t            )
  676.       (  (hunkp (setq s2 (set-create '(a (a)))))                 t            )
  677.       (  (set-list s1)                                     ''((a) a ((a)))    )
  678.       (  (set-list s2)                                     ''((a) a)          )
  679.       (  (set-list (set-and s1))                           ''((a) a ((a)))    )
  680.       (  (set-list (set-or s1))                            ''((a) a ((a)))    )
  681.       (  (set-list (set-diff s1))                          ''((a) a ((a)))    )
  682.       (  (set-list (set-and s1 s1))                        ''((a) a ((a)))    )
  683.       (  (set-list (set-or s1 s1))                         ''((a) a ((a)))    )
  684.       (  (set-list (set-diff s1 s1))                            nil           )
  685.       (  (set-list (set-and s1 '(a)))                         ''(a)           )
  686.       (  (set-list (set-and s1 s2))                        ''((a) a)          )
  687.       (  (set-list (set-or  s1 '(b)))                      ''((a) b a ((a)))  )
  688.       (  (set-list (set-or  s1 s2))                        ''((a) a ((a)))    )
  689.       (  (set-list (set-diff s1 s2))                        ''(((a)))         )
  690.       (  (set-list (set-or '(a) '(b) '(c) nil))             ''(c b a)         )
  691.       (  (set-list (set-or  '(a b) '(b a) '(c b a)))          ''(c b a)       )
  692.       (  (set-list (set-and '(a) '(b) '(c)))                    nil           )
  693.       (  (set-list (set-and '(a) '(a) '(a)))                    ''(a)         )
  694.       (  (set-list (set-and '(a b) '(b a) '(c b a)))            ''(b a)       )
  695.       (  (set-list (set-and '(a b) nil '(c b a)))               nil           )
  696.       (  (set-list (set-diff '(a b) '(b a) '(c b a)))           nil           )
  697.       (  (set-list (set-diff '(a b) '(b)))                      ''(a)         )
  698.       (  (set-list (set-diff nil '(b)))                         nil           )
  699.       (  (set-member (set-create (oblist)) 'set-create)          t            )
  700.    )
  701. )
  702.  
  703. ;;  Some data lists that are used by some of the test routines.
  704. ;;  Do not change them as their contents are important to test results.
  705.  
  706. (setq Data_1 '(a(b(c(d(e(f(g)))(h)(((((i)(((j)((k))(l]
  707. (setq Data_2 '(a(b(c(d(e(f('|g xx|)))(h . hi)(((((22)(((j)((k))(l]
  708. (array Data_Array t 5 20)
  709. (array Data_Array2 t 5 20)
  710. (setq Hunk_126 (makhunk 126))
  711. (setq Hunk_50 (makhunk 50))
  712. (setq Hunk_1 (makhunk 1))
  713.  
  714. ;;  Function AtomInList?(a l)
  715. ;;  ~~~~~~~~~~~~~~~~~~~~~~~~~
  716. ;;      Look through list l for atom a. If found return true else return nil.
  717.  
  718. (defun AtomInList?(a l)
  719.        (prog   ()
  720.      LOOP: (and (null l) (return nil)) 
  721.            (and (eq (car l) a) (return t)) 
  722.            (setq l (cdr l))
  723.            (go LOOP:)
  724.        )
  725. )
  726.  
  727.  
  728. ;;  Function Nearly Equal(a b)
  729. ;;  ~~~~~~~~~~~~~~~~~~~~~~~~~~
  730. ;;      Returns t if a and b are both numbers that are pretty close to each  
  731. ;;  other. The tolerance is .00001 just to give an idea that things are ok.
  732.  
  733. (defun NearlyEqual(a b)
  734.       (cond ((or (not (numbp a)) (not (numbp b))) nil)          
  735.         ((greaterp 0.00001 (abs (difference a b))) t)          
  736.         (t nil)       
  737.       )  
  738. )     
  739.  
  740. ;;  Function run(tracing)
  741. ;;  ~~~~~~~~~~~~~~~~~~~~~~
  742. ;;     Initiate one q&a test - trace if 'tracing' is non nil. This test can
  743. ;;  only be run once because of the expected side effects.
  744. ;;
  745.  
  746. (defun run(tracing) 
  747.     (prog (where) 
  748.           (setq where poport) 
  749.           (Q&A List#1_Math_Functions where tracing)      
  750.           (Q&A List#2_Predicates where tracing)
  751.           (Q&A List#3_Selectors_Creators where tracing)
  752.           (Q&A List#4_File_IO_Functions where tracing)
  753.           (Q&A List#5_Side_Effects where tracing)
  754.           (Q&A List#6_Destructives where tracing)
  755.           (Q&A List#7_ControlFlow where tracing)
  756.           (Q&A List#8_Sets where tracing)
  757.           (return t)  
  758.       )                 
  759. )
  760.