/[gcl]/gcl/ansi-tests/cons-test-09.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cons-test-09.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pfdietz, Mon Jan 13 14:11:49 2003 UTC revision 1.4 by pfdietz, Wed Jan 29 02:11:54 2003 UTC
# Line 47  Line 47 
47    nil)    nil)
48    
49  (deftest butlast-5  (deftest butlast-5
50      (catch-type-error (butlast (copy-tree '(a b c . d)) 1))    (butlast (copy-tree '(a b c . d)) 1)
51    (a b))    (a b))
52    
53  (deftest butlast-6  (deftest butlast.error.1
54      (catch-type-error (butlast (copy-tree '(a b c d)) 'a))    (classify-error (butlast (copy-tree '(a b c d)) 'a))
55    type-error)    type-error)
56    
57  (deftest butlast-7  (deftest butlast.error.2
58      (catch-type-error (butlast 'a 0))    (classify-error (butlast 'a 0))
59    type-error)    type-error)
60    
61  (deftest butlast-8  (deftest butlast.error.3
62    (classify-error (butlast))    (classify-error (butlast))
63    program-error)    program-error)
64    
65  (deftest butlast-9  (deftest butlast.error.4
66    (classify-error (butlast '(a b c) 3 3))    (classify-error (butlast '(a b c) 3 3))
67    program-error)    program-error)
68    
69    (deftest butlast.error.5
70      (classify-error (locally (butlast 'a 0) t))
71      type-error)
72    
73    
74    ;;; Tests of NBUTLAST
75    
76  (deftest nbutlast-1  (deftest nbutlast-1
77      (let ((x (list 'a 'b 'c 'd 'e)))    (let ((x (list 'a 'b 'c 'd 'e)))
78        (let ((y (cdr x))      (let ((y (cdr x))
79              (z (cddr x)))            (z (cddr x)))
80          (let ((result (nbutlast x 2)))        (let ((result (nbutlast x 2)))
81            (and (eqt x result)          (and (eqt x result)
82                 (eqt (cdr x) y)               (eqt (cdr x) y)
83                 (eqt (cddr x) z)               (eqt (cddr x) z)
84                 result))))               result))))
85    (a b c))    (a b c))
86    
87  (deftest nbutlast-2  (deftest nbutlast-2
88      (let ((x (list 'a 'b 'c 'd 'e)))    (let ((x (list 'a 'b 'c 'd 'e)))
89        (let ((result (nbutlast x 5)))      (let ((result (nbutlast x 5)))
90          (list x result)))        (list x result)))
91    ((a b c d e) nil))    ((a b c d e) nil))
92    
93  (deftest nbutlast-3  (deftest nbutlast-3
94      (let ((x (list 'a 'b 'c 'd 'e)))    (let ((x (list 'a 'b 'c 'd 'e)))
95        (let ((result (nbutlast x 500)))      (let ((result (nbutlast x 500)))
96          (list x result)))        (list x result)))
97    ((a b c d e) nil))    ((a b c d e) nil))
98    
99  (deftest nbutlast-4  (deftest nbutlast-4
100      (let ((x (list* 'a 'b 'c 'd)))    (let ((x (list* 'a 'b 'c 'd)))
101        (let ((result (catch-type-error (nbutlast x 1))))      (let ((result (nbutlast x 1)))
102          (and (eqt result x)        (and (eqt result x)
103               result)))             result)))
104    (a b))    (a b))
105    
106  (deftest nbutlast-5  (deftest nbutlast-5
107      (let ((x (list* 'a 'b 'c 'd)))    (classify-error (let ((x (list* 'a 'b 'c 'd))) (nbutlast x 'a)))
       (let ((result (catch-type-error (nbutlast x 'a))))  
         result))  
108    type-error)    type-error)
109    
110  (deftest nbutlast-6  (deftest nbutlast-6
111      (catch-type-error (nbutlast 'a 10))    (classify-error (nbutlast 'a 10))
112    type-error)    type-error)
113    
114  (deftest nbutlast-7  (deftest nbutlast-7
115      (catch-type-error (nbutlast 2 10))    (classify-error (nbutlast 2 10))
116    type-error)    type-error)
117    
118  (deftest nbutlast-8  (deftest nbutlast-8
119      (catch-type-error (nbutlast #\w 10))    (classify-error (nbutlast #\w 10))
120    type-error)    type-error)
121    
122  (deftest nbutlast-9  (deftest nbutlast-9
123      (catch-type-error (nbutlast (list 'a 'b 'c 'd) -3))    (classify-error (nbutlast (list 'a 'b 'c 'd) -3))
124    type-error)    type-error)
125    
126  (deftest nbutlast-10  (deftest nbutlast-10
127      (nbutlast nil)    (nbutlast nil)
128    nil)    nil)
129    
130  (deftest nbutlast-11  (deftest nbutlast-11
131      (nbutlast (list 'a))    (nbutlast (list 'a))
132    nil)    nil)
133    
134  (deftest nbutlast-12  (deftest nbutlast-12
135      (catch-type-error (nbutlast (list 'a) 20.0))    (classify-error (nbutlast (list 'a) 20.0))
136    type-error)    type-error)
137    
138  (deftest nbutlast-13  (deftest nbutlast-13
139      (catch-type-error (nbutlast (list 'a) -100.0))    (classify-error (nbutlast (list 'a) -100.0))
140    type-error)    type-error)
141    
142  (deftest nbutlast-14  (deftest nbutlast-14
# Line 141  Line 146 
146  (deftest nbutlast-15  (deftest nbutlast-15
147    (classify-error (nbutlast (list 'a 'b 'c) 3 3))    (classify-error (nbutlast (list 'a 'b 'c) 3 3))
148    program-error)    program-error)
149    
150    (deftest nbutlast-16
151      (classify-error (locally (nbutlast 'a 10) t))
152      type-error)

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26