|
428
|
1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
|
|
|
2
|
|
|
3 ;; Author: Martin Buchholz <martin@xemacs.org>
|
|
|
4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
|
|
|
5 ;; Created: 1998
|
|
|
6 ;; Keywords: tests
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF.
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;;; Test basic Lisp engine functionality
|
|
|
30 ;;; See test-harness.el for instructions on how to run these tests.
|
|
|
31
|
|
|
32 (eval-when-compile
|
|
|
33 (condition-case nil
|
|
|
34 (require 'test-harness)
|
|
|
35 (file-error
|
|
|
36 (push "." load-path)
|
|
|
37 (when (and (boundp 'load-file-name) (stringp load-file-name))
|
|
|
38 (push (file-name-directory load-file-name) load-path))
|
|
|
39 (require 'test-harness))))
|
|
|
40
|
|
|
41 (Check-Error wrong-number-of-arguments (setq setq-test-foo))
|
|
|
42 (Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar))
|
|
|
43 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo))
|
|
|
44 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar))
|
|
|
45 (Assert (eq (setq) nil))
|
|
|
46 (Assert (eq (setq-default) nil))
|
|
|
47 (Assert (eq (setq setq-test-foo 42) 42))
|
|
|
48 (Assert (eq (setq-default setq-test-foo 42) 42))
|
|
|
49 (Assert (eq (setq setq-test-foo 42 setq-test-bar 99) 99))
|
|
|
50 (Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99))
|
|
|
51
|
|
|
52 (macrolet ((test-setq (expected-result &rest body)
|
|
|
53 `(progn
|
|
|
54 (defun test-setq-fun () ,@body)
|
|
|
55 (Assert (eq ,expected-result (test-setq-fun)))
|
|
|
56 (byte-compile 'test-setq-fun)
|
|
|
57 (Assert (eq ,expected-result (test-setq-fun))))))
|
|
|
58 (test-setq nil (setq))
|
|
|
59 (test-setq nil (setq-default))
|
|
|
60 (test-setq 42 (setq test-setq-var 42))
|
|
|
61 (test-setq 42 (setq-default test-setq-var 42))
|
|
|
62 (test-setq 42 (setq test-setq-bar 99 test-setq-var 42))
|
|
|
63 (test-setq 42 (setq-default test-setq-bar 99 test-setq-var 42))
|
|
|
64 )
|
|
|
65
|
|
|
66 (let ((my-vector [1 2 3 4])
|
|
|
67 (my-bit-vector (bit-vector 1 0 1 0))
|
|
|
68 (my-string "1234")
|
|
|
69 (my-list '(1 2 3 4)))
|
|
|
70
|
|
|
71 ;;(Assert (fooooo)) ;; Generate Other failure
|
|
|
72 ;;(Assert (eq 1 2)) ;; Generate Assertion failure
|
|
|
73
|
|
|
74 (dolist (sequence (list my-vector my-bit-vector my-string my-list))
|
|
|
75 (Assert (sequencep sequence))
|
|
|
76 (Assert (eq 4 (length sequence))))
|
|
|
77
|
|
|
78 (dolist (array (list my-vector my-bit-vector my-string))
|
|
|
79 (Assert (arrayp array)))
|
|
|
80
|
|
|
81 (Assert (eq (elt my-vector 0) 1))
|
|
|
82 (Assert (eq (elt my-bit-vector 0) 1))
|
|
|
83 (Assert (eq (elt my-string 0) ?1))
|
|
|
84 (Assert (eq (elt my-list 0) 1))
|
|
|
85
|
|
|
86 (fillarray my-vector 5)
|
|
|
87 (fillarray my-bit-vector 1)
|
|
|
88 (fillarray my-string ?5)
|
|
|
89
|
|
|
90 (dolist (array (list my-vector my-bit-vector))
|
|
|
91 (Assert (eq 4 (length array))))
|
|
|
92
|
|
|
93 (Assert (eq (elt my-vector 0) 5))
|
|
|
94 (Assert (eq (elt my-bit-vector 0) 1))
|
|
|
95 (Assert (eq (elt my-string 0) ?5))
|
|
|
96
|
|
|
97 (Assert (eq (elt my-vector 3) 5))
|
|
|
98 (Assert (eq (elt my-bit-vector 3) 1))
|
|
|
99 (Assert (eq (elt my-string 3) ?5))
|
|
|
100
|
|
|
101 (fillarray my-bit-vector 0)
|
|
|
102 (Assert (eq 4 (length my-bit-vector)))
|
|
|
103 (Assert (eq (elt my-bit-vector 2) 0))
|
|
|
104 )
|
|
|
105
|
|
|
106 (defun make-circular-list (length)
|
|
|
107 "Create evil emacs-crashing circular list of length LENGTH"
|
|
|
108 (let ((circular-list
|
|
|
109 (make-list
|
|
|
110 length
|
|
|
111 'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike)))
|
|
|
112 (setcdr (last circular-list) circular-list)
|
|
|
113 circular-list))
|
|
|
114
|
|
|
115 ;;-----------------------------------------------------
|
|
|
116 ;; Test `nconc'
|
|
|
117 ;;-----------------------------------------------------
|
|
|
118 (defun make-list-012 () (list 0 1 2))
|
|
|
119
|
|
|
120 (Check-Error wrong-type-argument (nconc 'foo nil))
|
|
|
121
|
|
|
122 (dolist (length '(1 2 3 4 1000 2000))
|
|
|
123 (Check-Error circular-list (nconc (make-circular-list length) 'foo))
|
|
|
124 (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo))
|
|
|
125 (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo)))
|
|
|
126
|
|
|
127 (Assert (eq (nconc) nil))
|
|
|
128 (Assert (eq (nconc nil) nil))
|
|
|
129 (Assert (eq (nconc nil nil) nil))
|
|
|
130 (Assert (eq (nconc nil nil nil) nil))
|
|
|
131
|
|
|
132 (let ((x (make-list-012))) (Assert (eq (nconc nil x) x)))
|
|
|
133 (let ((x (make-list-012))) (Assert (eq (nconc x nil) x)))
|
|
|
134 (let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x)))
|
|
|
135 (let ((x (make-list-012))) (Assert (eq (nconc x) x)))
|
|
|
136 (let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x)))
|
|
|
137
|
|
|
138 (Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)))
|
|
|
139
|
|
|
140 (let ((y (nconc (make-list-012) nil (list 3 4 5) nil)))
|
|
|
141 (Assert (eq (length y) 6))
|
|
|
142 (Assert (eq (nth 3 y) 3)))
|
|
|
143
|
|
|
144 ;;-----------------------------------------------------
|
|
|
145 ;; Test `last'
|
|
|
146 ;;-----------------------------------------------------
|
|
|
147 (Check-Error wrong-type-argument (last 'foo))
|
|
|
148 (Check-Error wrong-number-of-arguments (last))
|
|
|
149 (Check-Error wrong-number-of-arguments (last '(1 2) 1 1))
|
|
|
150 (Check-Error circular-list (last (make-circular-list 1)))
|
|
|
151 (Check-Error circular-list (last (make-circular-list 2000)))
|
|
|
152 (let ((x (list 0 1 2 3)))
|
|
|
153 (Assert (eq (last nil) nil))
|
|
|
154 (Assert (eq (last x 0) nil))
|
|
|
155 (Assert (eq (last x ) (cdddr x)))
|
|
|
156 (Assert (eq (last x 1) (cdddr x)))
|
|
|
157 (Assert (eq (last x 2) (cddr x)))
|
|
|
158 (Assert (eq (last x 3) (cdr x)))
|
|
|
159 (Assert (eq (last x 4) x))
|
|
|
160 (Assert (eq (last x 9) x))
|
|
|
161 (Assert (eq (last '(1 . 2) 0) 2))
|
|
|
162 )
|
|
|
163
|
|
|
164 ;;-----------------------------------------------------
|
|
|
165 ;; Test `butlast' and `nbutlast'
|
|
|
166 ;;-----------------------------------------------------
|
|
|
167 (Check-Error wrong-type-argument (butlast 'foo))
|
|
|
168 (Check-Error wrong-type-argument (nbutlast 'foo))
|
|
|
169 (Check-Error wrong-number-of-arguments (butlast))
|
|
|
170 (Check-Error wrong-number-of-arguments (nbutlast))
|
|
|
171 (Check-Error wrong-number-of-arguments (butlast '(1 2) 1 1))
|
|
|
172 (Check-Error wrong-number-of-arguments (nbutlast '(1 2) 1 1))
|
|
|
173 (Check-Error circular-list (butlast (make-circular-list 1)))
|
|
|
174 (Check-Error circular-list (nbutlast (make-circular-list 1)))
|
|
|
175 (Check-Error circular-list (butlast (make-circular-list 2000)))
|
|
|
176 (Check-Error circular-list (nbutlast (make-circular-list 2000)))
|
|
|
177
|
|
|
178 (let* ((x (list 0 1 2 3))
|
|
|
179 (y (butlast x))
|
|
|
180 (z (nbutlast x)))
|
|
|
181 (Assert (eq z x))
|
|
|
182 (Assert (not (eq y x)))
|
|
|
183 (Assert (equal y '(0 1 2)))
|
|
|
184 (Assert (equal z y)))
|
|
|
185
|
|
|
186 (let* ((x (list 0 1 2 3 4))
|
|
|
187 (y (butlast x 2))
|
|
|
188 (z (nbutlast x 2)))
|
|
|
189 (Assert (eq z x))
|
|
|
190 (Assert (not (eq y x)))
|
|
|
191 (Assert (equal y '(0 1 2)))
|
|
|
192 (Assert (equal z y)))
|
|
|
193
|
|
|
194 (let* ((x (list 0 1 2 3))
|
|
|
195 (y (butlast x 0))
|
|
|
196 (z (nbutlast x 0)))
|
|
|
197 (Assert (eq z x))
|
|
|
198 (Assert (not (eq y x)))
|
|
|
199 (Assert (equal y '(0 1 2 3)))
|
|
|
200 (Assert (equal z y)))
|
|
|
201
|
|
|
202 (Assert (eq (butlast '(x)) nil))
|
|
|
203 (Assert (eq (nbutlast '(x)) nil))
|
|
|
204 (Assert (eq (butlast '()) nil))
|
|
|
205 (Assert (eq (nbutlast '()) nil))
|
|
|
206
|
|
|
207 ;;-----------------------------------------------------
|
|
|
208 ;; Test `copy-list'
|
|
|
209 ;;-----------------------------------------------------
|
|
|
210 (Check-Error wrong-type-argument (copy-list 'foo))
|
|
|
211 (Check-Error wrong-number-of-arguments (copy-list))
|
|
|
212 (Check-Error wrong-number-of-arguments (copy-list '(1 2) 1))
|
|
|
213 (Check-Error circular-list (copy-list (make-circular-list 1)))
|
|
|
214 (Check-Error circular-list (copy-list (make-circular-list 2000)))
|
|
|
215 (Assert (eq '() (copy-list '())))
|
|
|
216 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3)))
|
|
|
217 (let ((y (copy-list x)))
|
|
|
218 (Assert (and (equal x y) (not (eq x y))))))
|
|
|
219
|
|
|
220 ;;-----------------------------------------------------
|
|
|
221 ;; Arithmetic operations
|
|
|
222 ;;-----------------------------------------------------
|
|
|
223
|
|
|
224 ;; Test `+'
|
|
|
225 (Assert (eq (+ 1 1) 2))
|
|
|
226 (Assert (= (+ 1.0 1.0) 2.0))
|
|
|
227 (Assert (= (+ 1.0 3.0 0.0) 4.0))
|
|
|
228 (Assert (= (+ 1 1.0) 2.0))
|
|
|
229 (Assert (= (+ 1.0 1) 2.0))
|
|
|
230 (Assert (= (+ 1.0 1 1) 3.0))
|
|
|
231 (Assert (= (+ 1 1 1.0) 3.0))
|
|
1983
|
232 (if (featurep 'bignum)
|
|
|
233 (progn
|
|
|
234 (Assert (bignump (1+ most-positive-fixnum)))
|
|
|
235 (Assert (eq most-positive-fixnum (1- (1+ most-positive-fixnum))))
|
|
|
236 (Assert (bignump (+ most-positive-fixnum 1)))
|
|
|
237 (Assert (eq most-positive-fixnum (- (+ most-positive-fixnum 1) 1)))
|
|
|
238 (Assert (= (1+ most-positive-fixnum) (- most-negative-fixnum)))
|
|
|
239 (Assert (zerop (+ (* 3 most-negative-fixnum) (* 3 most-positive-fixnum)
|
|
|
240 3))))
|
|
|
241 (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum))
|
|
|
242 (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum)))
|
|
|
243
|
|
|
244 (when (featurep 'ratio)
|
|
|
245 (let ((threefourths (read "3/4"))
|
|
|
246 (threehalfs (read "3/2"))
|
|
|
247 (bigpos (div (+ most-positive-fixnum 2) (1+ most-positive-fixnum)))
|
|
|
248 (bigneg (div (+ most-positive-fixnum 2) most-negative-fixnum))
|
|
|
249 (negone (div (1+ most-positive-fixnum) most-negative-fixnum)))
|
|
|
250 (Assert (= negone -1))
|
|
|
251 (Assert (= threehalfs (+ threefourths threefourths)))
|
|
|
252 (Assert (zerop (+ bigpos bigneg)))))
|
|
428
|
253
|
|
|
254 ;; Test `-'
|
|
|
255 (Check-Error wrong-number-of-arguments (-))
|
|
|
256 (Assert (eq (- 0) 0))
|
|
|
257 (Assert (eq (- 1) -1))
|
|
|
258 (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1)))
|
|
|
259 (Assert (= (+ 1 one) 2))
|
|
|
260 (Assert (= (+ one) 1))
|
|
|
261 (Assert (= (+ one) one))
|
|
|
262 (Assert (= (- one) -1))
|
|
|
263 (Assert (= (- one one) 0))
|
|
|
264 (Assert (= (- one one one) -1))
|
|
464
|
265 (Assert (= (- 0 one) -1))
|
|
|
266 (Assert (= (- 0 one one) -2))
|
|
428
|
267 (Assert (= (+ one 1) 2))
|
|
|
268 (dolist (zero '(0 0.0 ?\0))
|
|
2056
|
269 (Assert (= (+ 1 zero) 1) zero)
|
|
|
270 (Assert (= (+ zero 1) 1) zero)
|
|
|
271 (Assert (= (- zero) zero) zero)
|
|
|
272 (Assert (= (- zero) 0) zero)
|
|
|
273 (Assert (= (- zero zero) 0) zero)
|
|
|
274 (Assert (= (- zero one one) -2) zero)))
|
|
428
|
275
|
|
|
276 (Assert (= (- 1.5 1) .5))
|
|
|
277 (Assert (= (- 1 1.5) (- .5)))
|
|
|
278
|
|
1983
|
279 (if (featurep 'bignum)
|
|
|
280 (progn
|
|
|
281 (Assert (bignump (1- most-negative-fixnum)))
|
|
|
282 (Assert (eq most-negative-fixnum (1+ (1- most-negative-fixnum))))
|
|
|
283 (Assert (bignump (- most-negative-fixnum 1)))
|
|
|
284 (Assert (eq most-negative-fixnum (+ (- most-negative-fixnum 1) 1)))
|
|
|
285 (Assert (= (1- most-negative-fixnum) (- 0 most-positive-fixnum 2)))
|
|
|
286 (Assert (eq (- (- most-positive-fixnum most-negative-fixnum)
|
|
|
287 (* 2 most-positive-fixnum))
|
|
|
288 1)))
|
|
|
289 (Assert (eq (1- most-negative-fixnum) most-positive-fixnum))
|
|
|
290 (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum)))
|
|
|
291
|
|
|
292 (when (featurep 'ratio)
|
|
|
293 (let ((threefourths (read "3/4"))
|
|
|
294 (threehalfs (read "3/2"))
|
|
|
295 (bigpos (div (+ most-positive-fixnum 2) (1+ most-positive-fixnum)))
|
|
|
296 (bigneg (div most-positive-fixnum most-negative-fixnum))
|
|
|
297 (negone (div (1+ most-positive-fixnum) most-negative-fixnum)))
|
|
|
298 (Assert (= (- negone) 1))
|
|
|
299 (Assert (= threefourths (- threehalfs threefourths)))
|
|
|
300 (Assert (= (- bigpos bigneg) 2))))
|
|
428
|
301
|
|
|
302 ;; Test `/'
|
|
|
303
|
|
|
304 ;; Test division by zero errors
|
|
|
305 (dolist (zero '(0 0.0 ?\0))
|
|
|
306 (Check-Error arith-error (/ zero))
|
|
|
307 (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
|
|
|
308 (Check-Error arith-error (/ n1 zero))
|
|
|
309 (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
|
|
|
310 (Check-Error arith-error (/ n1 n2 zero)))))
|
|
|
311
|
|
|
312 ;; Other tests for `/'
|
|
|
313 (Check-Error wrong-number-of-arguments (/))
|
|
|
314 (let (x)
|
|
|
315 (Assert (= (/ (setq x 2)) 0))
|
|
|
316 (Assert (= (/ (setq x 2.0)) 0.5)))
|
|
|
317
|
|
|
318 (dolist (six '(6 6.0 ?\06))
|
|
|
319 (dolist (two '(2 2.0 ?\02))
|
|
|
320 (dolist (three '(3 3.0 ?\03))
|
|
2056
|
321 (Assert (= (/ six two) three) (list six two three)))))
|
|
428
|
322
|
|
|
323 (dolist (three '(3 3.0 ?\03))
|
|
2056
|
324 (Assert (= (/ three 2.0) 1.5) three))
|
|
428
|
325 (dolist (two '(2 2.0 ?\02))
|
|
2056
|
326 (Assert (= (/ 3.0 two) 1.5) two))
|
|
428
|
327
|
|
1983
|
328 (when (featurep 'bignum)
|
|
|
329 (let* ((million 1000000)
|
|
|
330 (billion (* million 1000)) ;; American, not British, billion
|
|
|
331 (trillion (* billion 1000)))
|
|
|
332 (Assert (= (/ billion 1000) (/ trillion million) million 1000000.0))
|
|
|
333 (Assert (= (/ billion -1000) (/ trillion (- million)) (- million)))
|
|
|
334 (Assert (= (/ trillion 1000) billion 1000000000.0))
|
|
|
335 (Assert (= (/ trillion -1000) (- billion) -1000000000.0))
|
|
|
336 (Assert (= (/ trillion 10) (* 100 billion) 100000000000.0))
|
|
|
337 (Assert (= (/ (- trillion) 10) (* -100 billion) -100000000000.0))))
|
|
|
338
|
|
|
339 (when (featurep 'ratio)
|
|
|
340 (let ((half (div 1 2))
|
|
|
341 (fivefourths (div 5 4))
|
|
|
342 (fivehalfs (div 5 2)))
|
|
|
343 (Assert (= half (read "3000000000/6000000000")))
|
|
|
344 (Assert (= (/ fivehalfs fivefourths) 2))
|
|
|
345 (Assert (= (/ fivefourths fivehalfs) half))
|
|
|
346 (Assert (= (- half) (read "-3000000000/6000000000")))
|
|
|
347 (Assert (= (/ fivehalfs (- fivefourths)) -2))
|
|
|
348 (Assert (= (/ (- fivefourths) fivehalfs) (- half)))))
|
|
|
349
|
|
428
|
350 ;; Test `*'
|
|
|
351 (Assert (= 1 (*)))
|
|
|
352
|
|
|
353 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
|
|
2056
|
354 (Assert (= 1 (* one)) one))
|
|
428
|
355
|
|
|
356 (dolist (two '(2 2.0 ?\02))
|
|
2056
|
357 (Assert (= 2 (* two)) two))
|
|
428
|
358
|
|
|
359 (dolist (six '(6 6.0 ?\06))
|
|
|
360 (dolist (two '(2 2.0 ?\02))
|
|
|
361 (dolist (three '(3 3.0 ?\03))
|
|
2056
|
362 (Assert (= (* three two) six) (list three two six)))))
|
|
428
|
363
|
|
|
364 (dolist (three '(3 3.0 ?\03))
|
|
|
365 (dolist (two '(2 2.0 ?\02))
|
|
2056
|
366 (Assert (= (* 1.5 two) three) (list two three))
|
|
428
|
367 (dolist (five '(5 5.0 ?\05))
|
|
2056
|
368 (Assert (= 30 (* five two three)) (list five two three)))))
|
|
428
|
369
|
|
1983
|
370 (when (featurep 'bignum)
|
|
|
371 (let ((64K 65536))
|
|
|
372 (Assert (= (* 64K 64K) (read "4294967296")))
|
|
|
373 (Assert (= (* (- 64K) 64K) (read "-4294967296")))
|
|
|
374 (Assert (/= (* -1 most-negative-fixnum) most-negative-fixnum))))
|
|
|
375
|
|
|
376 (when (featurep 'ratio)
|
|
|
377 (let ((half (div 1 2))
|
|
|
378 (fivefourths (div 5 4))
|
|
|
379 (twofifths (div 2 5)))
|
|
|
380 (Assert (= (* fivefourths twofifths) half))
|
|
|
381 (Assert (= (* half twofifths) (read "3/15")))))
|
|
|
382
|
|
428
|
383 ;; Test `+'
|
|
|
384 (Assert (= 0 (+)))
|
|
|
385
|
|
|
386 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
|
|
2056
|
387 (Assert (= 1 (+ one)) one))
|
|
428
|
388
|
|
|
389 (dolist (two '(2 2.0 ?\02))
|
|
2056
|
390 (Assert (= 2 (+ two)) two))
|
|
428
|
391
|
|
|
392 (dolist (five '(5 5.0 ?\05))
|
|
|
393 (dolist (two '(2 2.0 ?\02))
|
|
|
394 (dolist (three '(3 3.0 ?\03))
|
|
2056
|
395 (Assert (= (+ three two) five) (list three two five))
|
|
|
396 (Assert (= 10 (+ five two three)) (list five two three)))))
|
|
428
|
397
|
|
|
398 ;; Test `max', `min'
|
|
|
399 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
|
|
2056
|
400 (Assert (= one (max one)) one)
|
|
|
401 (Assert (= one (max one one)) one)
|
|
|
402 (Assert (= one (max one one one)) one)
|
|
|
403 (Assert (= one (min one)) one)
|
|
|
404 (Assert (= one (min one one)) one)
|
|
|
405 (Assert (= one (min one one one)) one)
|
|
428
|
406 (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
|
|
2056
|
407 (Assert (= one (min one two)) (list one two))
|
|
|
408 (Assert (= one (min one two two)) (list one two))
|
|
|
409 (Assert (= one (min two two one)) (list one two))
|
|
|
410 (Assert (= two (max one two)) (list one two))
|
|
|
411 (Assert (= two (max one two two)) (list one two))
|
|
|
412 (Assert (= two (max two two one)) (list one two))))
|
|
428
|
413
|
|
1983
|
414 (when (featurep 'bignum)
|
|
|
415 (let ((big (1+ most-positive-fixnum))
|
|
|
416 (small (1- most-negative-fixnum)))
|
|
|
417 (Assert (= big (max 1 1000000.0 most-positive-fixnum big)))
|
|
|
418 (Assert (= small (min -1 -1000000.0 most-negative-fixnum small)))))
|
|
|
419
|
|
|
420 (when (featurep 'ratio)
|
|
|
421 (let* ((big (1+ most-positive-fixnum))
|
|
|
422 (small (1- most-negative-fixnum))
|
|
|
423 (bigr (div (* 5 (1+ most-positive-fixnum)) 4))
|
|
|
424 (smallr (- bigr)))
|
|
|
425 (Assert (= bigr (max 1 1000000.0 most-positive-fixnum big bigr)))
|
|
|
426 (Assert (= smallr (min -1 -1000000.0 most-negative-fixnum small smallr)))))
|
|
|
427
|
|
446
|
428 ;; The byte compiler has special handling for these constructs:
|
|
|
429 (let ((three 3) (five 5))
|
|
|
430 (Assert (= (+ three five 1) 9))
|
|
|
431 (Assert (= (+ 1 three five) 9))
|
|
|
432 (Assert (= (+ three five -1) 7))
|
|
|
433 (Assert (= (+ -1 three five) 7))
|
|
|
434 (Assert (= (+ three 1) 4))
|
|
|
435 (Assert (= (+ three -1) 2))
|
|
|
436 (Assert (= (+ -1 three) 2))
|
|
|
437 (Assert (= (+ -1 three) 2))
|
|
|
438 (Assert (= (- three five 1) -3))
|
|
|
439 (Assert (= (- 1 three five) -7))
|
|
|
440 (Assert (= (- three five -1) -1))
|
|
|
441 (Assert (= (- -1 three five) -9))
|
|
|
442 (Assert (= (- three 1) 2))
|
|
|
443 (Assert (= (- three 2 1) 0))
|
|
|
444 (Assert (= (- 2 three 1) -2))
|
|
|
445 (Assert (= (- three -1) 4))
|
|
|
446 (Assert (= (- three 0) 3))
|
|
|
447 (Assert (= (- three 0 five) -2))
|
|
|
448 (Assert (= (- 0 three 0 five) -8))
|
|
|
449 (Assert (= (- 0 three five) -8))
|
|
|
450 (Assert (= (* three 2) 6))
|
|
|
451 (Assert (= (* three -1 five) -15))
|
|
|
452 (Assert (= (* three 1 five) 15))
|
|
|
453 (Assert (= (* three 0 five) 0))
|
|
|
454 (Assert (= (* three 2 five) 30))
|
|
|
455 (Assert (= (/ three 1) 3))
|
|
|
456 (Assert (= (/ three -1) -3))
|
|
|
457 (Assert (= (/ (* five five) 2 2) 6))
|
|
|
458 (Assert (= (/ 64 five 2) 6)))
|
|
|
459
|
|
|
460
|
|
428
|
461 ;;-----------------------------------------------------
|
|
|
462 ;; Logical bit-twiddling operations
|
|
|
463 ;;-----------------------------------------------------
|
|
|
464 (Assert (= (logxor) 0))
|
|
|
465 (Assert (= (logior) 0))
|
|
|
466 (Assert (= (logand) -1))
|
|
|
467
|
|
|
468 (Check-Error wrong-type-argument (logxor 3.0))
|
|
|
469 (Check-Error wrong-type-argument (logior 3.0))
|
|
|
470 (Check-Error wrong-type-argument (logand 3.0))
|
|
|
471
|
|
|
472 (dolist (three '(3 ?\03))
|
|
2056
|
473 (Assert (eq 3 (logand three)) three)
|
|
|
474 (Assert (eq 3 (logxor three)) three)
|
|
|
475 (Assert (eq 3 (logior three)) three)
|
|
|
476 (Assert (eq 3 (logand three three)) three)
|
|
|
477 (Assert (eq 0 (logxor three three)) three)
|
|
|
478 (Assert (eq 3 (logior three three))) three)
|
|
428
|
479
|
|
|
480 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
|
|
|
481 (dolist (two '(2 ?\02))
|
|
2056
|
482 (Assert (eq 0 (logand one two)) (list one two))
|
|
|
483 (Assert (eq 3 (logior one two)) (list one two))
|
|
|
484 (Assert (eq 3 (logxor one two)) (list one two)))
|
|
428
|
485 (dolist (three '(3 ?\03))
|
|
2056
|
486 (Assert (eq 1 (logand one three)) (list one three))
|
|
|
487 (Assert (eq 3 (logior one three)) (list one three))
|
|
|
488 (Assert (eq 2 (logxor one three)) (list one three))))
|
|
428
|
489
|
|
|
490 ;;-----------------------------------------------------
|
|
|
491 ;; Test `%', mod
|
|
|
492 ;;-----------------------------------------------------
|
|
|
493 (Check-Error wrong-number-of-arguments (%))
|
|
|
494 (Check-Error wrong-number-of-arguments (% 1))
|
|
|
495 (Check-Error wrong-number-of-arguments (% 1 2 3))
|
|
|
496
|
|
|
497 (Check-Error wrong-number-of-arguments (mod))
|
|
|
498 (Check-Error wrong-number-of-arguments (mod 1))
|
|
|
499 (Check-Error wrong-number-of-arguments (mod 1 2 3))
|
|
|
500
|
|
|
501 (Check-Error wrong-type-argument (% 10.0 2))
|
|
|
502 (Check-Error wrong-type-argument (% 10 2.0))
|
|
|
503
|
|
2056
|
504 (flet ((test1 (x) (Assert (eql x (+ (% x 17) (* (/ x 17) 17))) x))
|
|
|
505 (test2 (x) (Assert (eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))) x))
|
|
|
506 (test3 (x) (Assert (eql x (+ (% (- x) 17) (* (/ (- x) 17) 17))) x))
|
|
2075
|
507 (test4 (x) (Assert (eql (% x -17) (- (% (- x) 17))) x))
|
|
|
508 (test5 (x) (Assert (eql (% x -17) (% (- x) 17))) x))
|
|
2056
|
509 (test1 most-negative-fixnum)
|
|
|
510 (if (featurep 'bignum)
|
|
2075
|
511 (progn
|
|
|
512 (test2 most-negative-fixnum)
|
|
|
513 (test4 most-negative-fixnum))
|
|
|
514 (test3 most-negative-fixnum)
|
|
|
515 (test5 most-negative-fixnum))
|
|
2056
|
516 (test1 most-positive-fixnum)
|
|
|
517 (test2 most-positive-fixnum)
|
|
|
518 (test4 most-positive-fixnum)
|
|
|
519 (dotimes (j 30)
|
|
|
520 (let ((x (random)))
|
|
|
521 (if (eq x most-negative-fixnum) (setq x (1+ x)))
|
|
|
522 (if (eq x most-positive-fixnum) (setq x (1- x)))
|
|
|
523 (test1 x)
|
|
|
524 (test2 x)
|
|
|
525 (test4 x))))
|
|
428
|
526
|
|
|
527 (macrolet
|
|
|
528 ((division-test (seven)
|
|
|
529 `(progn
|
|
|
530 (Assert (eq (% ,seven 2) 1))
|
|
|
531 (Assert (eq (% ,seven -2) 1))
|
|
|
532 (Assert (eq (% (- ,seven) 2) -1))
|
|
|
533 (Assert (eq (% (- ,seven) -2) -1))
|
|
|
534
|
|
|
535 (Assert (eq (% ,seven 4) 3))
|
|
|
536 (Assert (eq (% ,seven -4) 3))
|
|
|
537 (Assert (eq (% (- ,seven) 4) -3))
|
|
|
538 (Assert (eq (% (- ,seven) -4) -3))
|
|
|
539
|
|
|
540 (Assert (eq (% 35 ,seven) 0))
|
|
|
541 (Assert (eq (% -35 ,seven) 0))
|
|
|
542 (Assert (eq (% 35 (- ,seven)) 0))
|
|
|
543 (Assert (eq (% -35 (- ,seven)) 0))
|
|
|
544
|
|
|
545 (Assert (eq (mod ,seven 2) 1))
|
|
|
546 (Assert (eq (mod ,seven -2) -1))
|
|
|
547 (Assert (eq (mod (- ,seven) 2) 1))
|
|
|
548 (Assert (eq (mod (- ,seven) -2) -1))
|
|
|
549
|
|
|
550 (Assert (eq (mod ,seven 4) 3))
|
|
|
551 (Assert (eq (mod ,seven -4) -1))
|
|
|
552 (Assert (eq (mod (- ,seven) 4) 1))
|
|
|
553 (Assert (eq (mod (- ,seven) -4) -3))
|
|
|
554
|
|
|
555 (Assert (eq (mod 35 ,seven) 0))
|
|
|
556 (Assert (eq (mod -35 ,seven) 0))
|
|
|
557 (Assert (eq (mod 35 (- ,seven)) 0))
|
|
|
558 (Assert (eq (mod -35 (- ,seven)) 0))
|
|
|
559
|
|
|
560 (Assert (= (mod ,seven 2.0) 1.0))
|
|
|
561 (Assert (= (mod ,seven -2.0) -1.0))
|
|
|
562 (Assert (= (mod (- ,seven) 2.0) 1.0))
|
|
|
563 (Assert (= (mod (- ,seven) -2.0) -1.0))
|
|
|
564
|
|
|
565 (Assert (= (mod ,seven 4.0) 3.0))
|
|
|
566 (Assert (= (mod ,seven -4.0) -1.0))
|
|
|
567 (Assert (= (mod (- ,seven) 4.0) 1.0))
|
|
|
568 (Assert (= (mod (- ,seven) -4.0) -3.0))
|
|
|
569
|
|
|
570 (Assert (eq (% 0 ,seven) 0))
|
|
|
571 (Assert (eq (% 0 (- ,seven)) 0))
|
|
|
572
|
|
|
573 (Assert (eq (mod 0 ,seven) 0))
|
|
|
574 (Assert (eq (mod 0 (- ,seven)) 0))
|
|
|
575
|
|
|
576 (Assert (= (mod 0.0 ,seven) 0.0))
|
|
|
577 (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
|
|
|
578
|
|
|
579 (division-test 7)
|
|
|
580 (division-test ?\07)
|
|
|
581 (division-test (Int-to-Marker 7)))
|
|
|
582
|
|
1983
|
583 (when (featurep 'bignum)
|
|
|
584 (let ((big (+ (* 7 most-positive-fixnum 6)))
|
|
|
585 (negbig (- (* 7 most-negative-fixnum 6))))
|
|
|
586 (= (% big (1+ most-positive-fixnum)) most-positive-fixnum)
|
|
|
587 (= (% negbig (1- most-negative-fixnum)) most-negative-fixnum)
|
|
|
588 (= (mod big (1+ most-positive-fixnum)) most-positive-fixnum)
|
|
|
589 (= (mod negbig (1- most-negative-fixnum)) most-negative-fixnum)))
|
|
428
|
590
|
|
|
591 ;;-----------------------------------------------------
|
|
|
592 ;; Arithmetic comparison operations
|
|
|
593 ;;-----------------------------------------------------
|
|
|
594 (Check-Error wrong-number-of-arguments (=))
|
|
|
595 (Check-Error wrong-number-of-arguments (<))
|
|
|
596 (Check-Error wrong-number-of-arguments (>))
|
|
|
597 (Check-Error wrong-number-of-arguments (<=))
|
|
|
598 (Check-Error wrong-number-of-arguments (>=))
|
|
|
599 (Check-Error wrong-number-of-arguments (/=))
|
|
|
600
|
|
|
601 ;; One argument always yields t
|
|
|
602 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
|
|
2056
|
603 (Assert (eq t (= x)) x)
|
|
|
604 (Assert (eq t (< x)) x)
|
|
|
605 (Assert (eq t (> x)) x)
|
|
|
606 (Assert (eq t (>= x)) x)
|
|
|
607 (Assert (eq t (<= x)) x)
|
|
|
608 (Assert (eq t (/= x)) x)
|
|
428
|
609 )
|
|
|
610
|
|
|
611 ;; Type checking
|
|
|
612 (Check-Error wrong-type-argument (= 'foo 1))
|
|
|
613 (Check-Error wrong-type-argument (<= 'foo 1))
|
|
|
614 (Check-Error wrong-type-argument (>= 'foo 1))
|
|
|
615 (Check-Error wrong-type-argument (< 'foo 1))
|
|
|
616 (Check-Error wrong-type-argument (> 'foo 1))
|
|
|
617 (Check-Error wrong-type-argument (/= 'foo 1))
|
|
|
618
|
|
|
619 ;; Meat
|
|
|
620 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
|
|
|
621 (dolist (two '(2 2.0 ?\02))
|
|
2056
|
622 (Assert (< one two) (list one two))
|
|
|
623 (Assert (<= one two) (list one two))
|
|
|
624 (Assert (<= two two) two)
|
|
|
625 (Assert (> two one) (list one two))
|
|
|
626 (Assert (>= two one) (list one two))
|
|
|
627 (Assert (>= two two) two)
|
|
|
628 (Assert (/= one two) (list one two))
|
|
|
629 (Assert (not (/= two two)) two)
|
|
|
630 (Assert (not (< one one)) one)
|
|
|
631 (Assert (not (> one one)) one)
|
|
|
632 (Assert (<= one one two two) (list one two))
|
|
|
633 (Assert (not (< one one two two)) (list one two))
|
|
|
634 (Assert (>= two two one one) (list one two))
|
|
|
635 (Assert (not (> two two one one)) (list one two))
|
|
|
636 (Assert (= one one one) one)
|
|
|
637 (Assert (not (= one one one two)) (list one two))
|
|
|
638 (Assert (not (/= one two one)) (list one two))
|
|
428
|
639 ))
|
|
|
640
|
|
|
641 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
|
|
|
642 (dolist (two '(2 2.0 ?\02))
|
|
2056
|
643 (Assert (< one two) (list one two))
|
|
|
644 (Assert (<= one two) (list one two))
|
|
|
645 (Assert (<= two two) two)
|
|
|
646 (Assert (> two one) (list one two))
|
|
|
647 (Assert (>= two one) (list one two))
|
|
|
648 (Assert (>= two two) two)
|
|
|
649 (Assert (/= one two) (list one two))
|
|
|
650 (Assert (not (/= two two)) two)
|
|
|
651 (Assert (not (< one one)) one)
|
|
|
652 (Assert (not (> one one)) one)
|
|
|
653 (Assert (<= one one two two) (list one two))
|
|
|
654 (Assert (not (< one one two two)) (list one two))
|
|
|
655 (Assert (>= two two one one) (list one two))
|
|
|
656 (Assert (not (> two two one one)) (list one two))
|
|
|
657 (Assert (= one one one) one)
|
|
|
658 (Assert (not (= one one one two)) (list one two))
|
|
|
659 (Assert (not (/= one two one)) (list one two))
|
|
428
|
660 ))
|
|
|
661
|
|
|
662 ;; ad-hoc
|
|
|
663 (Assert (< 1 2))
|
|
|
664 (Assert (< 1 2 3 4 5 6))
|
|
|
665 (Assert (not (< 1 1)))
|
|
|
666 (Assert (not (< 2 1)))
|
|
|
667
|
|
|
668
|
|
|
669 (Assert (not (< 1 1)))
|
|
|
670 (Assert (< 1 2 3 4 5 6))
|
|
|
671 (Assert (<= 1 2 3 4 5 6))
|
|
|
672 (Assert (<= 1 2 3 4 5 6 6))
|
|
|
673 (Assert (not (< 1 2 3 4 5 6 6)))
|
|
|
674 (Assert (<= 1 1))
|
|
|
675
|
|
|
676 (Assert (not (eq (point) (point-marker))))
|
|
|
677 (Assert (= 1 (Int-to-Marker 1)))
|
|
|
678 (Assert (= (point) (point-marker)))
|
|
|
679
|
|
1983
|
680 (when (featurep 'bignum)
|
|
|
681 (let ((big1 (1+ most-positive-fixnum))
|
|
|
682 (big2 (* 10 most-positive-fixnum))
|
|
|
683 (small1 (1- most-negative-fixnum))
|
|
|
684 (small2 (* 10 most-negative-fixnum)))
|
|
|
685 (Assert (< small2 small1 most-negative-fixnum most-positive-fixnum big1
|
|
|
686 big2))
|
|
|
687 (Assert (<= small2 small1 most-negative-fixnum most-positive-fixnum big1
|
|
|
688 big2))
|
|
|
689 (Assert (> big2 big1 most-positive-fixnum most-negative-fixnum small1
|
|
|
690 small2))
|
|
|
691 (Assert (>= big2 big1 most-positive-fixnum most-negative-fixnum small1
|
|
|
692 small2))
|
|
|
693 (Assert (/= small2 small1 most-negative-fixnum most-positive-fixnum big1
|
|
|
694 big2))))
|
|
|
695
|
|
|
696 (when (featurep 'ratio)
|
|
|
697 (let ((big1 (div (* 10 most-positive-fixnum) 4))
|
|
|
698 (big2 (div (* 5 most-positive-fixnum) 2))
|
|
|
699 (big3 (div (* 7 most-positive-fixnum) 2))
|
|
|
700 (small1 (div (* 10 most-negative-fixnum) 4))
|
|
|
701 (small2 (div (* 5 most-negative-fixnum) 2))
|
|
|
702 (small3 (div (* 7 most-negative-fixnum) 2)))
|
|
|
703 (Assert (= big1 big2))
|
|
|
704 (Assert (= small1 small2))
|
|
|
705 (Assert (< small3 small1 most-negative-fixnum most-positive-fixnum big1
|
|
|
706 big3))
|
|
|
707 (Assert (<= small3 small2 small1 most-negative-fixnum most-positive-fixnum
|
|
|
708 big1 big2 big3))
|
|
|
709 (Assert (> big3 big1 most-positive-fixnum most-negative-fixnum small1
|
|
|
710 small3))
|
|
|
711 (Assert (>= big3 big2 big1 most-positive-fixnum most-negative-fixnum
|
|
|
712 small1 small2 small3))
|
|
|
713 (Assert (/= big3 big1 most-positive-fixnum most-negative-fixnum small1
|
|
|
714 small3))))
|
|
|
715
|
|
428
|
716 ;;-----------------------------------------------------
|
|
|
717 ;; testing list-walker functions
|
|
|
718 ;;-----------------------------------------------------
|
|
|
719 (macrolet
|
|
|
720 ((test-fun
|
|
|
721 (fun)
|
|
|
722 `(progn
|
|
|
723 (Check-Error wrong-number-of-arguments (,fun))
|
|
|
724 (Check-Error wrong-number-of-arguments (,fun nil))
|
|
|
725 (Check-Error malformed-list (,fun nil 1))
|
|
|
726 ,@(loop for n in '(1 2 2000)
|
|
|
727 collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
|
|
|
728 (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
|
|
|
729
|
|
|
730 (test-funs member old-member
|
|
|
731 memq old-memq
|
|
|
732 assoc old-assoc
|
|
|
733 rassoc old-rassoc
|
|
|
734 rassq old-rassq
|
|
|
735 delete old-delete
|
|
|
736 delq old-delq
|
|
|
737 remassoc remassq remrassoc remrassq))
|
|
|
738
|
|
|
739 (let ((x '((1 . 2) 3 (4 . 5))))
|
|
|
740 (Assert (eq (assoc 1 x) (car x)))
|
|
|
741 (Assert (eq (assq 1 x) (car x)))
|
|
|
742 (Assert (eq (rassoc 1 x) nil))
|
|
|
743 (Assert (eq (rassq 1 x) nil))
|
|
|
744 (Assert (eq (assoc 2 x) nil))
|
|
|
745 (Assert (eq (assq 2 x) nil))
|
|
|
746 (Assert (eq (rassoc 2 x) (car x)))
|
|
|
747 (Assert (eq (rassq 2 x) (car x)))
|
|
|
748 (Assert (eq (assoc 3 x) nil))
|
|
|
749 (Assert (eq (assq 3 x) nil))
|
|
|
750 (Assert (eq (rassoc 3 x) nil))
|
|
|
751 (Assert (eq (rassq 3 x) nil))
|
|
|
752 (Assert (eq (assoc 4 x) (caddr x)))
|
|
|
753 (Assert (eq (assq 4 x) (caddr x)))
|
|
|
754 (Assert (eq (rassoc 4 x) nil))
|
|
|
755 (Assert (eq (rassq 4 x) nil))
|
|
|
756 (Assert (eq (assoc 5 x) nil))
|
|
|
757 (Assert (eq (assq 5 x) nil))
|
|
|
758 (Assert (eq (rassoc 5 x) (caddr x)))
|
|
|
759 (Assert (eq (rassq 5 x) (caddr x)))
|
|
|
760 (Assert (eq (assoc 6 x) nil))
|
|
|
761 (Assert (eq (assq 6 x) nil))
|
|
|
762 (Assert (eq (rassoc 6 x) nil))
|
|
|
763 (Assert (eq (rassq 6 x) nil)))
|
|
|
764
|
|
|
765 (let ((x '(("1" . "2") "3" ("4" . "5"))))
|
|
|
766 (Assert (eq (assoc "1" x) (car x)))
|
|
|
767 (Assert (eq (assq "1" x) nil))
|
|
|
768 (Assert (eq (rassoc "1" x) nil))
|
|
|
769 (Assert (eq (rassq "1" x) nil))
|
|
|
770 (Assert (eq (assoc "2" x) nil))
|
|
|
771 (Assert (eq (assq "2" x) nil))
|
|
|
772 (Assert (eq (rassoc "2" x) (car x)))
|
|
|
773 (Assert (eq (rassq "2" x) nil))
|
|
|
774 (Assert (eq (assoc "3" x) nil))
|
|
|
775 (Assert (eq (assq "3" x) nil))
|
|
|
776 (Assert (eq (rassoc "3" x) nil))
|
|
|
777 (Assert (eq (rassq "3" x) nil))
|
|
|
778 (Assert (eq (assoc "4" x) (caddr x)))
|
|
|
779 (Assert (eq (assq "4" x) nil))
|
|
|
780 (Assert (eq (rassoc "4" x) nil))
|
|
|
781 (Assert (eq (rassq "4" x) nil))
|
|
|
782 (Assert (eq (assoc "5" x) nil))
|
|
|
783 (Assert (eq (assq "5" x) nil))
|
|
|
784 (Assert (eq (rassoc "5" x) (caddr x)))
|
|
|
785 (Assert (eq (rassq "5" x) nil))
|
|
|
786 (Assert (eq (assoc "6" x) nil))
|
|
|
787 (Assert (eq (assq "6" x) nil))
|
|
|
788 (Assert (eq (rassoc "6" x) nil))
|
|
|
789 (Assert (eq (rassq "6" x) nil)))
|
|
|
790
|
|
|
791 (flet ((a () (list '(1 . 2) 3 '(4 . 5))))
|
|
|
792 (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
793 (Assert (let* ((x (a)) (y (remassq 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
794 (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
|
|
|
795 (Assert (let* ((x (a)) (y (remrassq 1 x))) (and (eq x y) (equal y (a)))))
|
|
|
796
|
|
|
797 (Assert (let* ((x (a)) (y (remassoc 2 x))) (and (eq x y) (equal y (a)))))
|
|
|
798 (Assert (let* ((x (a)) (y (remassq 2 x))) (and (eq x y) (equal y (a)))))
|
|
|
799 (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
800 (Assert (let* ((x (a)) (y (remrassq 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
801
|
|
|
802 (Assert (let* ((x (a)) (y (remassoc 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
803 (Assert (let* ((x (a)) (y (remassq 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
804 (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
805 (Assert (let* ((x (a)) (y (remrassq 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
806
|
|
|
807 (Assert (let* ((x (a)) (y (remassoc 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
808 (Assert (let* ((x (a)) (y (remassq 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
809 (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
|
|
|
810 (Assert (let* ((x (a)) (y (remrassq 4 x))) (and (eq x y) (equal y (a)))))
|
|
|
811
|
|
|
812 (Assert (let* ((x (a)) (y (remassoc 5 x))) (and (eq x y) (equal y (a)))))
|
|
|
813 (Assert (let* ((x (a)) (y (remassq 5 x))) (and (eq x y) (equal y (a)))))
|
|
|
814 (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
815 (Assert (let* ((x (a)) (y (remrassq 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
816
|
|
|
817 (Assert (let* ((x (a)) (y (remassoc 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
818 (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
819 (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
820 (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
821
|
|
|
822 (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
823 (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
824 (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
825 (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
826
|
|
|
827 (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
828 (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
|
|
|
829 (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
830 (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
|
|
|
831 )
|
|
|
832
|
|
|
833
|
|
|
834
|
|
|
835 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
|
|
|
836 (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
|
|
|
837 (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a)))))
|
|
|
838 (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
|
|
|
839 (Assert (let* ((x (a)) (y (remrassq "1" x))) (and (eq x y) (equal y (a)))))
|
|
|
840
|
|
|
841 (Assert (let* ((x (a)) (y (remassoc "2" x))) (and (eq x y) (equal y (a)))))
|
|
|
842 (Assert (let* ((x (a)) (y (remassq "2" x))) (and (eq x y) (equal y (a)))))
|
|
|
843 (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
|
|
|
844 (Assert (let* ((x (a)) (y (remrassq "2" x))) (and (eq x y) (equal y (a)))))
|
|
|
845
|
|
|
846 (Assert (let* ((x (a)) (y (remassoc "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
847 (Assert (let* ((x (a)) (y (remassq "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
848 (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
849 (Assert (let* ((x (a)) (y (remrassq "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
850
|
|
|
851 (Assert (let* ((x (a)) (y (remassoc "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
|
|
|
852 (Assert (let* ((x (a)) (y (remassq "4" x))) (and (eq x y) (equal y (a)))))
|
|
|
853 (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
|
|
|
854 (Assert (let* ((x (a)) (y (remrassq "4" x))) (and (eq x y) (equal y (a)))))
|
|
|
855
|
|
|
856 (Assert (let* ((x (a)) (y (remassoc "5" x))) (and (eq x y) (equal y (a)))))
|
|
|
857 (Assert (let* ((x (a)) (y (remassq "5" x))) (and (eq x y) (equal y (a)))))
|
|
|
858 (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
|
|
|
859 (Assert (let* ((x (a)) (y (remrassq "5" x))) (and (eq x y) (equal y (a)))))
|
|
|
860
|
|
|
861 (Assert (let* ((x (a)) (y (remassoc "6" x))) (and (eq x y) (equal y (a)))))
|
|
|
862 (Assert (let* ((x (a)) (y (remassq "6" x))) (and (eq x y) (equal y (a)))))
|
|
|
863 (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
|
|
|
864 (Assert (let* ((x (a)) (y (remrassq "6" x))) (and (eq x y) (equal y (a))))))
|
|
|
865
|
|
|
866 ;;-----------------------------------------------------
|
|
|
867 ;; function-max-args, function-min-args
|
|
|
868 ;;-----------------------------------------------------
|
|
|
869 (defmacro check-function-argcounts (fun min max)
|
|
|
870 `(progn
|
|
|
871 (Assert (eq (function-min-args ,fun) ,min))
|
|
|
872 (Assert (eq (function-max-args ,fun) ,max))))
|
|
|
873
|
|
|
874 (check-function-argcounts 'prog1 1 nil) ; special form
|
|
|
875 (check-function-argcounts 'command-execute 1 3) ; normal subr
|
|
|
876 (check-function-argcounts 'funcall 1 nil) ; `MANY' subr
|
|
|
877 (check-function-argcounts 'garbage-collect 0 0) ; no args subr
|
|
|
878
|
|
|
879 ;; Test interpreted and compiled functions
|
|
|
880 (loop for (arglist min max) in
|
|
|
881 '(((arg1 arg2 &rest args) 2 nil)
|
|
|
882 ((arg1 arg2 &optional arg3 arg4) 2 4)
|
|
|
883 ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
|
|
|
884 (() 0 0))
|
|
|
885 do
|
|
|
886 (eval
|
|
|
887 `(progn
|
|
|
888 (defun test-fun ,arglist nil)
|
|
|
889 (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
|
|
|
890 (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
|
|
|
891
|
|
|
892 ;;-----------------------------------------------------
|
|
|
893 ;; Detection of cyclic variable indirection loops
|
|
|
894 ;;-----------------------------------------------------
|
|
|
895 (fset 'test-sym1 'test-sym1)
|
|
|
896 (Check-Error cyclic-function-indirection (test-sym1))
|
|
|
897
|
|
|
898 (fset 'test-sym1 'test-sym2)
|
|
|
899 (fset 'test-sym2 'test-sym1)
|
|
|
900 (Check-Error cyclic-function-indirection (test-sym1))
|
|
|
901 (fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
|
|
|
902 (fmakunbound 'test-sym2)
|
|
|
903
|
|
|
904 ;;-----------------------------------------------------
|
|
|
905 ;; Test `type-of'
|
|
|
906 ;;-----------------------------------------------------
|
|
|
907 (Assert (eq (type-of load-path) 'cons))
|
|
|
908 (Assert (eq (type-of obarray) 'vector))
|
|
|
909 (Assert (eq (type-of 42) 'integer))
|
|
|
910 (Assert (eq (type-of ?z) 'character))
|
|
|
911 (Assert (eq (type-of "42") 'string))
|
|
|
912 (Assert (eq (type-of 'foo) 'symbol))
|
|
|
913 (Assert (eq (type-of (selected-device)) 'device))
|
|
|
914
|
|
|
915 ;;-----------------------------------------------------
|
|
|
916 ;; Test mapping functions
|
|
|
917 ;;-----------------------------------------------------
|
|
|
918 (Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
|
|
|
919 (Assert (equal (mapcar #'identity load-path) load-path))
|
|
|
920 (Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3)))
|
|
|
921 (Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3)))
|
|
|
922 (Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3)))
|
|
|
923 (Assert (equal (mapcar #'identity #*010) '(0 1 0)))
|
|
|
924
|
|
|
925 (let ((z 0) (list (make-list 1000 1)))
|
|
|
926 (mapc (lambda (x) (incf z x)) list)
|
|
|
927 (Assert (eq 1000 z)))
|
|
|
928
|
|
|
929 (Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
|
|
|
930 (Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3]))
|
|
|
931 (Assert (equal (mapvector #'identity "123") [?1 ?2 ?3]))
|
|
|
932 (Assert (equal (mapvector #'identity [1 2 3]) [1 2 3]))
|
|
|
933 (Assert (equal (mapvector #'identity #*010) [0 1 0]))
|
|
|
934
|
|
|
935 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
|
|
|
936 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
|
|
|
937 (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3"))
|
|
|
938
|
|
434
|
939 ;; The following 2 functions used to crash XEmacs via mapcar1().
|
|
|
940 ;; We don't test the actual values of the mapcar, since they're undefined.
|
|
446
|
941 (Assert
|
|
434
|
942 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
|
|
|
943 (mapcar
|
|
|
944 (lambda (y)
|
|
|
945 "Devious evil mapping function"
|
|
|
946 (when (eq (car y) 2) ; go out onto a limb
|
|
|
947 (setcdr x nil) ; cut it off behind us
|
|
|
948 (garbage-collect)) ; are we riding a magic broomstick?
|
|
|
949 (car y)) ; sorry, hard landing
|
|
|
950 x)))
|
|
|
951
|
|
446
|
952 (Assert
|
|
434
|
953 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
|
|
|
954 (mapcar
|
|
|
955 (lambda (y)
|
|
|
956 "Devious evil mapping function"
|
|
|
957 (when (eq (car y) 1)
|
|
|
958 (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
|
|
|
959 (car y))
|
|
|
960 x)))
|
|
|
961
|
|
428
|
962 ;;-----------------------------------------------------
|
|
|
963 ;; Test vector functions
|
|
|
964 ;;-----------------------------------------------------
|
|
|
965 (Assert (equal [1 2 3] [1 2 3]))
|
|
|
966 (Assert (equal [] []))
|
|
|
967 (Assert (not (equal [1 2 3] [])))
|
|
|
968 (Assert (not (equal [1 2 3] [1 2 4])))
|
|
|
969 (Assert (not (equal [0 2 3] [1 2 3])))
|
|
|
970 (Assert (not (equal [1 2 3] [1 2 3 4])))
|
|
|
971 (Assert (not (equal [1 2 3 4] [1 2 3])))
|
|
|
972 (Assert (equal (vector 1 2 3) [1 2 3]))
|
|
|
973 (Assert (equal (make-vector 3 1) [1 1 1]))
|
|
|
974
|
|
|
975 ;;-----------------------------------------------------
|
|
|
976 ;; Test bit-vector functions
|
|
|
977 ;;-----------------------------------------------------
|
|
|
978 (Assert (equal #*010 #*010))
|
|
|
979 (Assert (equal #* #*))
|
|
|
980 (Assert (not (equal #*010 #*011)))
|
|
|
981 (Assert (not (equal #*010 #*)))
|
|
|
982 (Assert (not (equal #*110 #*010)))
|
|
|
983 (Assert (not (equal #*010 #*0100)))
|
|
|
984 (Assert (not (equal #*0101 #*010)))
|
|
|
985 (Assert (equal (bit-vector 0 1 0) #*010))
|
|
|
986 (Assert (equal (make-bit-vector 3 1) #*111))
|
|
|
987 (Assert (equal (make-bit-vector 3 0) #*000))
|
|
|
988
|
|
|
989 ;;-----------------------------------------------------
|
|
|
990 ;; Test buffer-local variables used as (ugh!) function parameters
|
|
|
991 ;;-----------------------------------------------------
|
|
|
992 (make-local-variable 'test-emacs-buffer-local-variable)
|
|
|
993 (byte-compile
|
|
|
994 (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable)
|
|
|
995 (setq test-emacs-buffer-local-variable nil)))
|
|
|
996 (test-emacs-buffer-local-parameter nil)
|
|
|
997
|
|
|
998 ;;-----------------------------------------------------
|
|
|
999 ;; Test split-string
|
|
|
1000 ;;-----------------------------------------------------
|
|
1425
|
1001 ;; Keep nulls, explicit SEPARATORS
|
|
|
1002 ;; Hrvoje didn't like the next 3 tests so I'm disabling them for now. -sb
|
|
|
1003 ;; I assume Hrvoje worried about the possibility of infloops. -sjt
|
|
|
1004 (when test-harness-risk-infloops
|
|
|
1005 (Assert (equal (split-string "foo" "") '("" "f" "o" "o" "")))
|
|
|
1006 (Assert (equal (split-string "foo" "^") '("" "foo")))
|
|
|
1007 (Assert (equal (split-string "foo" "$") '("foo" ""))))
|
|
428
|
1008 (Assert (equal (split-string "foo,bar" ",") '("foo" "bar")))
|
|
|
1009 (Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")))
|
|
|
1010 (Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,")))
|
|
|
1011 (Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" "")))
|
|
|
1012 (Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")))
|
|
|
1013 (Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")))
|
|
|
1014 (Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")))
|
|
|
1015 (Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar")))
|
|
|
1016 (Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")))
|
|
1425
|
1017 ;; Omit nulls, explicit SEPARATORS
|
|
|
1018 (when test-harness-risk-infloops
|
|
|
1019 (Assert (equal (split-string "foo" "" t) '("f" "o" "o")))
|
|
|
1020 (Assert (equal (split-string "foo" "^" t) '("foo")))
|
|
|
1021 (Assert (equal (split-string "foo" "$" t) '("foo"))))
|
|
|
1022 (Assert (equal (split-string "foo,bar" "," t) '("foo" "bar")))
|
|
|
1023 (Assert (equal (split-string ",foo,bar," "," t) '("foo" "bar")))
|
|
|
1024 (Assert (equal (split-string ",foo,bar," "^," t) '("foo,bar,")))
|
|
|
1025 (Assert (equal (split-string ",foo,bar," ",$" t) '(",foo,bar")))
|
|
|
1026 (Assert (equal (split-string ",foo,,bar," "," t) '("foo" "bar")))
|
|
|
1027 (Assert (equal (split-string "foo,,,bar" "," t) '("foo" "bar")))
|
|
|
1028 (Assert (equal (split-string "foo,,bar,," "," t) '("foo" "bar")))
|
|
|
1029 (Assert (equal (split-string "foo,,bar" ",+" t) '("foo" "bar")))
|
|
|
1030 (Assert (equal (split-string ",foo,,bar," ",+" t) '("foo" "bar")))
|
|
|
1031 ;; "Double-default" case
|
|
|
1032 (Assert (equal (split-string "foo bar") '("foo" "bar")))
|
|
|
1033 (Assert (equal (split-string " foo bar ") '("foo" "bar")))
|
|
|
1034 (Assert (equal (split-string " foo bar ") '("foo" "bar")))
|
|
|
1035 (Assert (equal (split-string "foo bar") '("foo" "bar")))
|
|
|
1036 (Assert (equal (split-string "foo bar ") '("foo" "bar")))
|
|
|
1037 (Assert (equal (split-string "foobar") '("foobar")))
|
|
|
1038 ;; Semantics are identical to "double-default" case! Fool ya?
|
|
|
1039 (Assert (equal (split-string "foo bar" nil t) '("foo" "bar")))
|
|
|
1040 (Assert (equal (split-string " foo bar " nil t) '("foo" "bar")))
|
|
|
1041 (Assert (equal (split-string " foo bar " nil t) '("foo" "bar")))
|
|
|
1042 (Assert (equal (split-string "foo bar" nil t) '("foo" "bar")))
|
|
|
1043 (Assert (equal (split-string "foo bar " nil t) '("foo" "bar")))
|
|
|
1044 (Assert (equal (split-string "foobar" nil t) '("foobar")))
|
|
|
1045 ;; Perverse "anti-double-default" case
|
|
|
1046 (Assert (equal (split-string "foo bar" split-string-default-separators)
|
|
|
1047 '("foo" "bar")))
|
|
|
1048 (Assert (equal (split-string " foo bar " split-string-default-separators)
|
|
|
1049 '("" "foo" "bar" "")))
|
|
|
1050 (Assert (equal (split-string " foo bar " split-string-default-separators)
|
|
|
1051 '("" "foo" "bar" "")))
|
|
|
1052 (Assert (equal (split-string "foo bar" split-string-default-separators)
|
|
|
1053 '("foo" "bar")))
|
|
|
1054 (Assert (equal (split-string "foo bar " split-string-default-separators)
|
|
|
1055 '("foo" "bar" "")))
|
|
|
1056 (Assert (equal (split-string "foobar" split-string-default-separators)
|
|
|
1057 '("foobar")))
|
|
434
|
1058
|
|
442
|
1059 (Assert (not (string-match "\\(\\.\\=\\)" ".")))
|
|
446
|
1060 (Assert (string= "" (let ((str "test string"))
|
|
444
|
1061 (if (string-match "^.*$" str)
|
|
|
1062 (replace-match "\\U" t nil str)))))
|
|
|
1063 (with-temp-buffer
|
|
|
1064 (erase-buffer)
|
|
|
1065 (insert "test string")
|
|
|
1066 (re-search-backward "^.*$")
|
|
|
1067 (replace-match "\\U" t)
|
|
|
1068 (Assert (and (bobp) (eobp))))
|
|
442
|
1069
|
|
434
|
1070 ;;-----------------------------------------------------
|
|
|
1071 ;; Test near-text buffer functions.
|
|
|
1072 ;;-----------------------------------------------------
|
|
|
1073 (with-temp-buffer
|
|
|
1074 (erase-buffer)
|
|
|
1075 (Assert (eq (char-before) nil))
|
|
|
1076 (Assert (eq (char-before (point)) nil))
|
|
|
1077 (Assert (eq (char-before (point-marker)) nil))
|
|
|
1078 (Assert (eq (char-before (point) (current-buffer)) nil))
|
|
|
1079 (Assert (eq (char-before (point-marker) (current-buffer)) nil))
|
|
|
1080 (Assert (eq (char-after) nil))
|
|
|
1081 (Assert (eq (char-after (point)) nil))
|
|
|
1082 (Assert (eq (char-after (point-marker)) nil))
|
|
|
1083 (Assert (eq (char-after (point) (current-buffer)) nil))
|
|
|
1084 (Assert (eq (char-after (point-marker) (current-buffer)) nil))
|
|
|
1085 (Assert (eq (preceding-char) 0))
|
|
|
1086 (Assert (eq (preceding-char (current-buffer)) 0))
|
|
|
1087 (Assert (eq (following-char) 0))
|
|
|
1088 (Assert (eq (following-char (current-buffer)) 0))
|
|
|
1089 (insert "foobar")
|
|
|
1090 (Assert (eq (char-before) ?r))
|
|
|
1091 (Assert (eq (char-after) nil))
|
|
|
1092 (Assert (eq (preceding-char) ?r))
|
|
|
1093 (Assert (eq (following-char) 0))
|
|
|
1094 (goto-char (point-min))
|
|
|
1095 (Assert (eq (char-before) nil))
|
|
|
1096 (Assert (eq (char-after) ?f))
|
|
|
1097 (Assert (eq (preceding-char) 0))
|
|
|
1098 (Assert (eq (following-char) ?f))
|
|
|
1099 )
|
|
440
|
1100
|
|
|
1101 ;;-----------------------------------------------------
|
|
|
1102 ;; Test plist manipulation functions.
|
|
|
1103 ;;-----------------------------------------------------
|
|
|
1104 (let ((sym (make-symbol "test-symbol")))
|
|
|
1105 (Assert (eq t (get* sym t t)))
|
|
|
1106 (Assert (eq t (get sym t t)))
|
|
|
1107 (Assert (eq t (getf nil t t)))
|
|
|
1108 (Assert (eq t (plist-get nil t t)))
|
|
|
1109 (put sym 'bar 'baz)
|
|
|
1110 (Assert (eq 'baz (get sym 'bar)))
|
|
|
1111 (Assert (eq 'baz (getf '(bar baz) 'bar)))
|
|
|
1112 (Assert (eq 'baz (getf (symbol-plist sym) 'bar)))
|
|
|
1113 (Assert (eq 2 (getf '(1 2) 1)))
|
|
442
|
1114 (Assert (eq 4 (put sym 3 4)))
|
|
|
1115 (Assert (eq 4 (get sym 3)))
|
|
|
1116 (Assert (eq t (remprop sym 3)))
|
|
|
1117 (Assert (eq nil (remprop sym 3)))
|
|
|
1118 (Assert (eq 5 (get sym 3 5)))
|
|
440
|
1119 )
|
|
442
|
1120
|
|
|
1121 (loop for obj in
|
|
|
1122 (list (make-symbol "test-symbol")
|
|
|
1123 "test-string"
|
|
|
1124 (make-extent nil nil nil)
|
|
|
1125 (make-face 'test-face))
|
|
|
1126 do
|
|
2056
|
1127 (Assert (eq 2 (get obj ?1 2)) obj)
|
|
|
1128 (Assert (eq 4 (put obj ?3 4)) obj)
|
|
|
1129 (Assert (eq 4 (get obj ?3)) obj)
|
|
442
|
1130 (when (or (stringp obj) (symbolp obj))
|
|
2056
|
1131 (Assert (equal '(?3 4) (object-plist obj)) obj))
|
|
|
1132 (Assert (eq t (remprop obj ?3)) obj)
|
|
442
|
1133 (when (or (stringp obj) (symbolp obj))
|
|
2056
|
1134 (Assert (eq '() (object-plist obj)) obj))
|
|
|
1135 (Assert (eq nil (remprop obj ?3)) obj)
|
|
442
|
1136 (when (or (stringp obj) (symbolp obj))
|
|
2056
|
1137 (Assert (eq '() (object-plist obj)) obj))
|
|
|
1138 (Assert (eq 5 (get obj ?3 5)) obj)
|
|
442
|
1139 )
|
|
|
1140
|
|
|
1141 (Check-Error-Message
|
|
|
1142 error "Object type has no properties"
|
|
|
1143 (get 2 'property))
|
|
|
1144
|
|
|
1145 (Check-Error-Message
|
|
|
1146 error "Object type has no settable properties"
|
|
|
1147 (put (current-buffer) 'property 'value))
|
|
|
1148
|
|
|
1149 (Check-Error-Message
|
|
|
1150 error "Object type has no removable properties"
|
|
|
1151 (remprop ?3 'property))
|
|
|
1152
|
|
|
1153 (Check-Error-Message
|
|
|
1154 error "Object type has no properties"
|
|
|
1155 (object-plist (symbol-function 'car)))
|
|
|
1156
|
|
|
1157 (Check-Error-Message
|
|
|
1158 error "Can't remove property from object"
|
|
|
1159 (remprop (make-extent nil nil nil) 'detachable))
|
|
|
1160
|
|
|
1161 ;;-----------------------------------------------------
|
|
|
1162 ;; Test subseq
|
|
|
1163 ;;-----------------------------------------------------
|
|
|
1164 (Assert (equal (subseq nil 0) nil))
|
|
|
1165 (Assert (equal (subseq [1 2 3] 0) [1 2 3]))
|
|
|
1166 (Assert (equal (subseq [1 2 3] 1 -1) [2]))
|
|
|
1167 (Assert (equal (subseq "123" 0) "123"))
|
|
|
1168 (Assert (equal (subseq "1234" -3 -1) "23"))
|
|
|
1169 (Assert (equal (subseq #*0011 0) #*0011))
|
|
|
1170 (Assert (equal (subseq #*0011 -3 3) #*01))
|
|
|
1171 (Assert (equal (subseq '(1 2 3) 0) '(1 2 3)))
|
|
|
1172 (Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)))
|
|
|
1173
|
|
446
|
1174 (Check-Error wrong-type-argument (subseq 3 2))
|
|
|
1175 (Check-Error args-out-of-range (subseq [1 2 3] -42))
|
|
|
1176 (Check-Error args-out-of-range (subseq [1 2 3] 0 42))
|
|
442
|
1177
|
|
|
1178 ;;-----------------------------------------------------
|
|
|
1179 ;; Time-related tests
|
|
|
1180 ;;-----------------------------------------------------
|
|
|
1181 (Assert (= (length (current-time-string)) 24))
|
|
444
|
1182
|
|
|
1183 ;;-----------------------------------------------------
|
|
|
1184 ;; format test
|
|
|
1185 ;;-----------------------------------------------------
|
|
|
1186 (Assert (string= (format "%d" 10) "10"))
|
|
|
1187 (Assert (string= (format "%o" 8) "10"))
|
|
|
1188 (Assert (string= (format "%x" 31) "1f"))
|
|
|
1189 (Assert (string= (format "%X" 31) "1F"))
|
|
826
|
1190 ;; MS-Windows uses +002 in its floating-point numbers. #### We should
|
|
|
1191 ;; perhaps fix this, but writing our own floating-point support in doprnt.c
|
|
|
1192 ;; is very hard.
|
|
|
1193 (Assert (or (string= (format "%e" 100) "1.000000e+02")
|
|
|
1194 (string= (format "%e" 100) "1.000000e+002")))
|
|
|
1195 (Assert (or (string= (format "%E" 100) "1.000000E+02")
|
|
|
1196 (string= (format "%E" 100) "1.000000E+002")))
|
|
|
1197 (Assert (or (string= (format "%E" 100) "1.000000E+02")
|
|
|
1198 (string= (format "%E" 100) "1.000000E+002")))
|
|
444
|
1199 (Assert (string= (format "%f" 100) "100.000000"))
|
|
448
|
1200 (Assert (string= (format "%7.3f" 12.12345) " 12.123"))
|
|
|
1201 (Assert (string= (format "%07.3f" 12.12345) "012.123"))
|
|
|
1202 (Assert (string= (format "%-7.3f" 12.12345) "12.123 "))
|
|
|
1203 (Assert (string= (format "%-07.3f" 12.12345) "12.123 "))
|
|
444
|
1204 (Assert (string= (format "%g" 100.0) "100"))
|
|
826
|
1205 (Assert (or (string= (format "%g" 0.000001) "1e-06")
|
|
|
1206 (string= (format "%g" 0.000001) "1e-006")))
|
|
444
|
1207 (Assert (string= (format "%g" 0.0001) "0.0001"))
|
|
|
1208 (Assert (string= (format "%G" 100.0) "100"))
|
|
826
|
1209 (Assert (or (string= (format "%G" 0.000001) "1E-06")
|
|
|
1210 (string= (format "%G" 0.000001) "1E-006")))
|
|
444
|
1211 (Assert (string= (format "%G" 0.0001) "0.0001"))
|
|
|
1212
|
|
|
1213 (Assert (string= (format "%2$d%1$d" 10 20) "2010"))
|
|
|
1214 (Assert (string= (format "%-d" 10) "10"))
|
|
|
1215 (Assert (string= (format "%-4d" 10) "10 "))
|
|
|
1216 (Assert (string= (format "%+d" 10) "+10"))
|
|
|
1217 (Assert (string= (format "%+d" -10) "-10"))
|
|
|
1218 (Assert (string= (format "%+4d" 10) " +10"))
|
|
|
1219 (Assert (string= (format "%+4d" -10) " -10"))
|
|
|
1220 (Assert (string= (format "% d" 10) " 10"))
|
|
|
1221 (Assert (string= (format "% d" -10) "-10"))
|
|
|
1222 (Assert (string= (format "% 4d" 10) " 10"))
|
|
|
1223 (Assert (string= (format "% 4d" -10) " -10"))
|
|
|
1224 (Assert (string= (format "%0d" 10) "10"))
|
|
|
1225 (Assert (string= (format "%0d" -10) "-10"))
|
|
|
1226 (Assert (string= (format "%04d" 10) "0010"))
|
|
|
1227 (Assert (string= (format "%04d" -10) "-010"))
|
|
|
1228 (Assert (string= (format "%*d" 4 10) " 10"))
|
|
|
1229 (Assert (string= (format "%*d" 4 -10) " -10"))
|
|
|
1230 (Assert (string= (format "%*d" -4 10) "10 "))
|
|
|
1231 (Assert (string= (format "%*d" -4 -10) "-10 "))
|
|
|
1232 (Assert (string= (format "%#d" 10) "10"))
|
|
|
1233 (Assert (string= (format "%#o" 8) "010"))
|
|
|
1234 (Assert (string= (format "%#x" 16) "0x10"))
|
|
826
|
1235 (Assert (or (string= (format "%#e" 100) "1.000000e+02")
|
|
|
1236 (string= (format "%#e" 100) "1.000000e+002")))
|
|
|
1237 (Assert (or (string= (format "%#E" 100) "1.000000E+02")
|
|
|
1238 (string= (format "%#E" 100) "1.000000E+002")))
|
|
444
|
1239 (Assert (string= (format "%#f" 100) "100.000000"))
|
|
|
1240 (Assert (string= (format "%#g" 100.0) "100.000"))
|
|
826
|
1241 (Assert (or (string= (format "%#g" 0.000001) "1.00000e-06")
|
|
|
1242 (string= (format "%#g" 0.000001) "1.00000e-006")))
|
|
444
|
1243 (Assert (string= (format "%#g" 0.0001) "0.000100000"))
|
|
|
1244 (Assert (string= (format "%#G" 100.0) "100.000"))
|
|
826
|
1245 (Assert (or (string= (format "%#G" 0.000001) "1.00000E-06")
|
|
|
1246 (string= (format "%#G" 0.000001) "1.00000E-006")))
|
|
444
|
1247 (Assert (string= (format "%#G" 0.0001) "0.000100000"))
|
|
|
1248 (Assert (string= (format "%.1d" 10) "10"))
|
|
|
1249 (Assert (string= (format "%.4d" 10) "0010"))
|
|
|
1250 ;; Combination of `-', `+', ` ', `0', `#', `.', `*'
|
|
448
|
1251 (Assert (string= (format "%-04d" 10) "10 "))
|
|
444
|
1252 (Assert (string= (format "%-*d" 4 10) "10 "))
|
|
|
1253 ;; #### Correctness of this behavior is questionable.
|
|
|
1254 ;; It might be better to signal error.
|
|
|
1255 (Assert (string= (format "%-*d" -4 10) "10 "))
|
|
|
1256 ;; These behavior is not specified.
|
|
|
1257 ;; (format "%-+d" 10)
|
|
|
1258 ;; (format "%- d" 10)
|
|
|
1259 ;; (format "%-01d" 10)
|
|
|
1260 ;; (format "%-#4x" 10)
|
|
|
1261 ;; (format "%-.1d" 10)
|
|
|
1262
|
|
|
1263 (Assert (string= (format "%01.1d" 10) "10"))
|
|
448
|
1264 (Assert (string= (format "%03.1d" 10) " 10"))
|
|
|
1265 (Assert (string= (format "%01.3d" 10) "010"))
|
|
|
1266 (Assert (string= (format "%1.3d" 10) "010"))
|
|
444
|
1267 (Assert (string= (format "%3.1d" 10) " 10"))
|
|
446
|
1268
|
|
448
|
1269 ;;; The following two tests used to use 1000 instead of 100,
|
|
|
1270 ;;; but that merely found buffer overflow bugs in Solaris sprintf().
|
|
|
1271 (Assert (= 102 (length (format "%.100f" 3.14))))
|
|
|
1272 (Assert (= 100 (length (format "%100f" 3.14))))
|
|
|
1273
|
|
446
|
1274 ;;; Check for 64-bit cleanness on LP64 platforms.
|
|
|
1275 (Assert (= (read (format "%d" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1276 (Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1277 (Assert (= (read (format "%u" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1278 (Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1279 (Assert (= (read (format "%d" most-negative-fixnum)) most-negative-fixnum))
|
|
|
1280 (Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum))
|
|
|
1281
|
|
|
1282 ;;; "%u" is undocumented, and Emacs Lisp has no unsigned type.
|
|
|
1283 ;;; What to do if "%u" is used with a negative number?
|
|
1983
|
1284 ;;; For non-bignum XEmacsen, the most reasonable thing seems to be to print an
|
|
|
1285 ;;; un-read-able number. The printed value might be useful to a human, if not
|
|
|
1286 ;;; to Emacs Lisp.
|
|
|
1287 ;;; For bignum XEmacsen, we make %u with a negative value throw an error.
|
|
|
1288 (if (featurep 'bignum)
|
|
|
1289 (progn
|
|
|
1290 (Check-Error wrong-type-argument (format "%u" most-negative-fixnum))
|
|
|
1291 (Check-Error wrong-type-argument (format "%u" -1)))
|
|
|
1292 (Check-Error invalid-read-syntax (read (format "%u" most-negative-fixnum)))
|
|
|
1293 (Check-Error invalid-read-syntax (read (format "%u" -1))))
|
|
448
|
1294
|
|
|
1295 ;; Check all-completions ignore element start with space.
|
|
|
1296 (Assert (not (all-completions "" '((" hidden" . "object")))))
|
|
|
1297 (Assert (all-completions " " '((" hidden" . "object"))))
|
