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