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

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

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

revision 1.6 by pfdietz, Fri Jan 24 04:22:54 2003 UTC revision 1.7 by pfdietz, Wed Jan 29 02:11:54 2003 UTC
# Line 35  Line 35 
35  (deftest ldiff-3  (deftest ldiff-3
36      (let* ((x (copy-tree '(a b c d e . f)))      (let* ((x (copy-tree '(a b c d e . f)))
37             (xcopy (make-scaffold-copy x)))             (xcopy (make-scaffold-copy x)))
38        (let ((result (catch-type-error (ldiff x 'a))))        (let ((result (ldiff x 'a)))
39          (and          (and
40           (check-scaffold-copy x xcopy)           (check-scaffold-copy x xcopy)
41           result)))           result)))
# Line 46  Line 46 
46    (let* ((n 18)    (let* ((n 18)
47           (x (list* 'a 'b 'c 18))           (x (list* 'a 'b 'c 18))
48           (xcopy (make-scaffold-copy x)))           (xcopy (make-scaffold-copy x)))
49      (let ((result (catch-type-error (ldiff x n))))      (let ((result (ldiff x n)))
50        (and        (and
51         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
52         result)))         result)))
# Line 58  Line 58 
58    (let* ((n 18000000000000)    (let* ((n 18000000000000)
59           (x (list* 'a 'b 'c (1- 18000000000001)))           (x (list* 'a 'b 'c (1- 18000000000001)))
60           (xcopy (make-scaffold-copy x)))           (xcopy (make-scaffold-copy x)))
61      (let ((result (catch-type-error (ldiff x n))))      (let ((result (ldiff x n)))
62        (and        (and
63         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
64         result)))         result)))
# Line 69  Line 69 
69    (let* ((n (copy-seq "abcde"))    (let* ((n (copy-seq "abcde"))
70           (x (list* 'a 'b 'c n))           (x (list* 'a 'b 'c n))
71           (xcopy (make-scaffold-copy x)))           (xcopy (make-scaffold-copy x)))
72      (let ((result (catch-type-error (ldiff x n))))      (let ((result (ldiff x n)))
73        (if (equal result (list 'a 'b 'c))        (if (equal result (list 'a 'b 'c))
74            (check-scaffold-copy x xcopy)            (check-scaffold-copy x xcopy)
75          result)))          result)))
# Line 81  Line 81 
81    (let* ((n (copy-seq "abcde"))    (let* ((n (copy-seq "abcde"))
82           (x (list* 'a 'b 'c n))           (x (list* 'a 'b 'c n))
83           (xcopy (make-scaffold-copy x)))           (xcopy (make-scaffold-copy x)))
84      (let ((result (catch-type-error (ldiff x (copy-seq n)))))      (let ((result (ldiff x (copy-seq n))))
85        (if (equal result x)        (if (equal result x)
86            (check-scaffold-copy x xcopy)            (check-scaffold-copy x xcopy)
87          result)))          result)))
# Line 104  Line 104 
104  ;; Error checking  ;; Error checking
105    
106  (deftest ldiff.error.1  (deftest ldiff.error.1
107    (catch-type-error (ldiff 10 'a))    (classify-error (ldiff 10 'a))
108    type-error)    type-error)
109    
110  ;; Single atoms are not dotted lists, so the next  ;; Single atoms are not dotted lists, so the next
111  ;; case should be a type-error  ;; case should be a type-error
112  (deftest ldiff.error.2  (deftest ldiff.error.2
113    (catch-type-error (ldiff 'a 'a))    (classify-error (ldiff 'a 'a))
114    type-error)    type-error)
115    
116  (deftest ldiff.error.3  (deftest ldiff.error.3
117    (catch-type-error (ldiff (make-array '(10) :initial-element 'a) '(a)))    (classify-error (ldiff (make-array '(10) :initial-element 'a) '(a)))
118    type-error)    type-error)
119    
120  (deftest ldiff.error.4  (deftest ldiff.error.4
121      (catch-type-error (ldiff 1.23 t))      (classify-error (ldiff 1.23 t))
122    type-error)    type-error)
123    
124  (deftest ldiff.error.5  (deftest ldiff.error.5
125      (catch-type-error (ldiff #\w 'a))      (classify-error (ldiff #\w 'a))
126    type-error)    type-error)
127    
128  (deftest ldiff.error.6  (deftest ldiff.error.6
# Line 177  Line 177 
177  ;; The next four tests test that tailp handles dotted lists.  See  ;; The next four tests test that tailp handles dotted lists.  See
178  ;; TAILP-NIL:T in the X3J13 documentation.  ;; TAILP-NIL:T in the X3J13 documentation.
179    
180  (deftest tailp.error.1  (deftest tailp-2
181    (catch-type-error (notnot-mv (tailp 'e (copy-tree '(a b c d . e)))))    (notnot-mv (tailp 'e (copy-tree '(a b c d . e))))
182    t)    t)
183    
184  (deftest tailp.error.2  (deftest tailp-3
185    (catch-type-error (tailp 'z (copy-tree '(a b c d . e))))    (tailp 'z (copy-tree '(a b c d . e)))
186    nil)    nil)
187    
188  (deftest tailp.error.3  (deftest tailp-4
189    (catch-type-error (notnot-mv (tailp 10203040506070    (notnot-mv (tailp 10203040506070
190          (list* 'a 'b (1- 10203040506071)))))                      (list* 'a 'b (1- 10203040506071))))
191    t)    t)
192    
193  (deftest tailp.error.4  (deftest tailp-5
194    (let ((x "abcde"))    (let ((x "abcde")) (tailp x (list* 'a 'b (copy-seq x))))
     (catch-type-error (tailp x (list* 'a 'b (copy-seq x)))))  
195    nil)    nil)
196    
197  (deftest tailp.error.5  (deftest tailp.error.5

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

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