|
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))
|
|
|
232 (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum))
|
|
|
233 (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum))
|
|
|
234
|
|
|
235 ;; Test `-'
|
|
|
236 (Check-Error wrong-number-of-arguments (-))
|
|
|
237 (Assert (eq (- 0) 0))
|
|
|
238 (Assert (eq (- 1) -1))
|
|
|
239 (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1)))
|
|
|
240 (Assert (= (+ 1 one) 2))
|
|
|
241 (Assert (= (+ one) 1))
|
|
|
242 (Assert (= (+ one) one))
|
|
|
243 (Assert (= (- one) -1))
|
|
|
244 (Assert (= (- one one) 0))
|
|
|
245 (Assert (= (- one one one) -1))
|
|
464
|
246 (Assert (= (- 0 one) -1))
|
|
|
247 (Assert (= (- 0 one one) -2))
|
|
428
|
248 (Assert (= (+ one 1) 2))
|
|
|
249 (dolist (zero '(0 0.0 ?\0))
|
|
|
250 (Assert (= (+ 1 zero) 1))
|
|
|
251 (Assert (= (+ zero 1) 1))
|
|
|
252 (Assert (= (- zero) zero))
|
|
|
253 (Assert (= (- zero) 0))
|
|
|
254 (Assert (= (- zero zero) 0))
|
|
|
255 (Assert (= (- zero one one) -2))))
|
|
|
256
|
|
|
257 (Assert (= (- 1.5 1) .5))
|
|
|
258 (Assert (= (- 1 1.5) (- .5)))
|
|
|
259
|
|
|
260 (Assert (eq (1- most-negative-fixnum) most-positive-fixnum))
|
|
|
261 (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum))
|
|
|
262
|
|
|
263 ;; Test `/'
|
|
|
264
|
|
|
265 ;; Test division by zero errors
|
|
|
266 (dolist (zero '(0 0.0 ?\0))
|
|
|
267 (Check-Error arith-error (/ zero))
|
|
|
268 (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
|
|
|
269 (Check-Error arith-error (/ n1 zero))
|
|
|
270 (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
|
|
|
271 (Check-Error arith-error (/ n1 n2 zero)))))
|
|
|
272
|
|
|
273 ;; Other tests for `/'
|
|
|
274 (Check-Error wrong-number-of-arguments (/))
|
|
|
275 (let (x)
|
|
|
276 (Assert (= (/ (setq x 2)) 0))
|
|
|
277 (Assert (= (/ (setq x 2.0)) 0.5)))
|
|
|
278
|
|
|
279 (dolist (six '(6 6.0 ?\06))
|
|
|
280 (dolist (two '(2 2.0 ?\02))
|
|
|
281 (dolist (three '(3 3.0 ?\03))
|
|
|
282 (Assert (= (/ six two) three)))))
|
|
|
283
|
|
|
284 (dolist (three '(3 3.0 ?\03))
|
|
|
285 (Assert (= (/ three 2.0) 1.5)))
|
|
|
286 (dolist (two '(2 2.0 ?\02))
|
|
|
287 (Assert (= (/ 3.0 two) 1.5)))
|
|
|
288
|
|
|
289 ;; Test `*'
|
|
|
290 (Assert (= 1 (*)))
|
|
|
291
|
|
|
292 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
|
|
|
293 (Assert (= 1 (* one))))
|
|
|
294
|
|
|
295 (dolist (two '(2 2.0 ?\02))
|
|
|
296 (Assert (= 2 (* two))))
|
|
|
297
|
|
|
298 (dolist (six '(6 6.0 ?\06))
|
|
|
299 (dolist (two '(2 2.0 ?\02))
|
|
|
300 (dolist (three '(3 3.0 ?\03))
|
|
|
301 (Assert (= (* three two) six)))))
|
|
|
302
|
|
|
303 (dolist (three '(3 3.0 ?\03))
|
|
|
304 (dolist (two '(2 2.0 ?\02))
|
|
|
305 (Assert (= (* 1.5 two) three))
|
|
|
306 (dolist (five '(5 5.0 ?\05))
|
|
|
307 (Assert (= 30 (* five two three))))))
|
|
|
308
|
|
|
309 ;; Test `+'
|
|
|
310 (Assert (= 0 (+)))
|
|
|
311
|
|
|
312 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
|
|
|
313 (Assert (= 1 (+ one))))
|
|
|
314
|
|
|
315 (dolist (two '(2 2.0 ?\02))
|
|
|
316 (Assert (= 2 (+ two))))
|
|
|
317
|
|
|
318 (dolist (five '(5 5.0 ?\05))
|
|
|
319 (dolist (two '(2 2.0 ?\02))
|
|
|
320 (dolist (three '(3 3.0 ?\03))
|
|
|
321 (Assert (= (+ three two) five))
|
|
|
322 (Assert (= 10 (+ five two three))))))
|
|
|
323
|
|
|
324 ;; Test `max', `min'
|
|
|
325 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
|
|
|
326 (Assert (= one (max one)))
|
|
|
327 (Assert (= one (max one one)))
|
|
|
328 (Assert (= one (max one one one)))
|
|
|
329 (Assert (= one (min one)))
|
|
|
330 (Assert (= one (min one one)))
|
|
|
331 (Assert (= one (min one one one)))
|
|
|
332 (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
|
|
|
333 (Assert (= one (min one two)))
|
|
|
334 (Assert (= one (min one two two)))
|
|
|
335 (Assert (= one (min two two one)))
|
|
|
336 (Assert (= two (max one two)))
|
|
|
337 (Assert (= two (max one two two)))
|
|
|
338 (Assert (= two (max two two one)))))
|
|
|
339
|
|
446
|
340 ;; The byte compiler has special handling for these constructs:
|
|
|
341 (let ((three 3) (five 5))
|
|
|
342 (Assert (= (+ three five 1) 9))
|
|
|
343 (Assert (= (+ 1 three five) 9))
|
|
|
344 (Assert (= (+ three five -1) 7))
|
|
|
345 (Assert (= (+ -1 three five) 7))
|
|
|
346 (Assert (= (+ three 1) 4))
|
|
|
347 (Assert (= (+ three -1) 2))
|
|
|
348 (Assert (= (+ -1 three) 2))
|
|
|
349 (Assert (= (+ -1 three) 2))
|
|
|
350 (Assert (= (- three five 1) -3))
|
|
|
351 (Assert (= (- 1 three five) -7))
|
|
|
352 (Assert (= (- three five -1) -1))
|
|
|
353 (Assert (= (- -1 three five) -9))
|
|
|
354 (Assert (= (- three 1) 2))
|
|
|
355 (Assert (= (- three 2 1) 0))
|
|
|
356 (Assert (= (- 2 three 1) -2))
|
|
|
357 (Assert (= (- three -1) 4))
|
|
|
358 (Assert (= (- three 0) 3))
|
|
|
359 (Assert (= (- three 0 five) -2))
|
|
|
360 (Assert (= (- 0 three 0 five) -8))
|
|
|
361 (Assert (= (- 0 three five) -8))
|
|
|
362 (Assert (= (* three 2) 6))
|
|
|
363 (Assert (= (* three -1 five) -15))
|
|
|
364 (Assert (= (* three 1 five) 15))
|
|
|
365 (Assert (= (* three 0 five) 0))
|
|
|
366 (Assert (= (* three 2 five) 30))
|
|
|
367 (Assert (= (/ three 1) 3))
|
|
|
368 (Assert (= (/ three -1) -3))
|
|
|
369 (Assert (= (/ (* five five) 2 2) 6))
|
|
|
370 (Assert (= (/ 64 five 2) 6)))
|
|
|
371
|
|
|
372
|
|
428
|
373 ;;-----------------------------------------------------
|
|
|
374 ;; Logical bit-twiddling operations
|
|
|
375 ;;-----------------------------------------------------
|
|
|
376 (Assert (= (logxor) 0))
|
|
|
377 (Assert (= (logior) 0))
|
|
|
378 (Assert (= (logand) -1))
|
|
|
379
|
|
|
380 (Check-Error wrong-type-argument (logxor 3.0))
|
|
|
381 (Check-Error wrong-type-argument (logior 3.0))
|
|
|
382 (Check-Error wrong-type-argument (logand 3.0))
|
|
|
383
|
|
|
384 (dolist (three '(3 ?\03))
|
|
|
385 (Assert (eq 3 (logand three)))
|
|
|
386 (Assert (eq 3 (logxor three)))
|
|
|
387 (Assert (eq 3 (logior three)))
|
|
|
388 (Assert (eq 3 (logand three three)))
|
|
|
389 (Assert (eq 0 (logxor three three)))
|
|
|
390 (Assert (eq 3 (logior three three))))
|
|
|
391
|
|
|
392 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
|
|
|
393 (dolist (two '(2 ?\02))
|
|
|
394 (Assert (eq 0 (logand one two)))
|
|
|
395 (Assert (eq 3 (logior one two)))
|
|
|
396 (Assert (eq 3 (logxor one two))))
|
|
|
397 (dolist (three '(3 ?\03))
|
|
|
398 (Assert (eq 1 (logand one three)))
|
|
|
399 (Assert (eq 3 (logior one three)))
|
|
|
400 (Assert (eq 2 (logxor one three)))))
|
|
|
401
|
|
|
402 ;;-----------------------------------------------------
|
|
|
403 ;; Test `%', mod
|
|
|
404 ;;-----------------------------------------------------
|
|
|
405 (Check-Error wrong-number-of-arguments (%))
|
|
|
406 (Check-Error wrong-number-of-arguments (% 1))
|
|
|
407 (Check-Error wrong-number-of-arguments (% 1 2 3))
|
|
|
408
|
|
|
409 (Check-Error wrong-number-of-arguments (mod))
|
|
|
410 (Check-Error wrong-number-of-arguments (mod 1))
|
|
|
411 (Check-Error wrong-number-of-arguments (mod 1 2 3))
|
|
|
412
|
|
|
413 (Check-Error wrong-type-argument (% 10.0 2))
|
|
|
414 (Check-Error wrong-type-argument (% 10 2.0))
|
|
|
415
|
|
|
416 (dotimes (j 30)
|
|
|
417 (let ((x (- (random) (random))))
|
|
|
418 (Assert (eq x (+ (% x 17) (* (/ x 17) 17))))
|
|
|
419 (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))))
|
|
|
420 (Assert (eq (% x -17) (- (% (- x) 17))))
|
|
|
421 ))
|
|
|
422
|
|
|
423 (macrolet
|
|
|
424 ((division-test (seven)
|
|
|
425 `(progn
|
|
|
426 (Assert (eq (% ,seven 2) 1))
|
|
|
427 (Assert (eq (% ,seven -2) 1))
|
|
|
428 (Assert (eq (% (- ,seven) 2) -1))
|
|
|
429 (Assert (eq (% (- ,seven) -2) -1))
|
|
|
430
|
|
|
431 (Assert (eq (% ,seven 4) 3))
|
|
|
432 (Assert (eq (% ,seven -4) 3))
|
|
|
433 (Assert (eq (% (- ,seven) 4) -3))
|
|
|
434 (Assert (eq (% (- ,seven) -4) -3))
|
|
|
435
|
|
|
436 (Assert (eq (% 35 ,seven) 0))
|
|
|
437 (Assert (eq (% -35 ,seven) 0))
|
|
|
438 (Assert (eq (% 35 (- ,seven)) 0))
|
|
|
439 (Assert (eq (% -35 (- ,seven)) 0))
|
|
|
440
|
|
|
441 (Assert (eq (mod ,seven 2) 1))
|
|
|
442 (Assert (eq (mod ,seven -2) -1))
|
|
|
443 (Assert (eq (mod (- ,seven) 2) 1))
|
|
|
444 (Assert (eq (mod (- ,seven) -2) -1))
|
|
|
445
|
|
|
446 (Assert (eq (mod ,seven 4) 3))
|
|
|
447 (Assert (eq (mod ,seven -4) -1))
|
|
|
448 (Assert (eq (mod (- ,seven) 4) 1))
|
|
|
449 (Assert (eq (mod (- ,seven) -4) -3))
|
|
|
450
|
|
|
451 (Assert (eq (mod 35 ,seven) 0))
|
|
|
452 (Assert (eq (mod -35 ,seven) 0))
|
|
|
453 (Assert (eq (mod 35 (- ,seven)) 0))
|
|
|
454 (Assert (eq (mod -35 (- ,seven)) 0))
|
|
|
455
|
|
|
456 (Assert (= (mod ,seven 2.0) 1.0))
|
|
|
457 (Assert (= (mod ,seven -2.0) -1.0))
|
|
|
458 (Assert (= (mod (- ,seven) 2.0) 1.0))
|
|
|
459 (Assert (= (mod (- ,seven) -2.0) -1.0))
|
|
|
460
|
|
|
461 (Assert (= (mod ,seven 4.0) 3.0))
|
|
|
462 (Assert (= (mod ,seven -4.0) -1.0))
|
|
|
463 (Assert (= (mod (- ,seven) 4.0) 1.0))
|
|
|
464 (Assert (= (mod (- ,seven) -4.0) -3.0))
|
|
|
465
|
|
|
466 (Assert (eq (% 0 ,seven) 0))
|
|
|
467 (Assert (eq (% 0 (- ,seven)) 0))
|
|
|
468
|
|
|
469 (Assert (eq (mod 0 ,seven) 0))
|
|
|
470 (Assert (eq (mod 0 (- ,seven)) 0))
|
|
|
471
|
|
|
472 (Assert (= (mod 0.0 ,seven) 0.0))
|
|
|
473 (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
|
|
|
474
|
|
|
475 (division-test 7)
|
|
|
476 (division-test ?\07)
|
|
|
477 (division-test (Int-to-Marker 7)))
|
|
|
478
|
|
|
479
|
|
|
480
|
|
|
481 ;;-----------------------------------------------------
|
|
|
482 ;; Arithmetic comparison operations
|
|
|
483 ;;-----------------------------------------------------
|
|
|
484 (Check-Error wrong-number-of-arguments (=))
|
|
|
485 (Check-Error wrong-number-of-arguments (<))
|
|
|
486 (Check-Error wrong-number-of-arguments (>))
|
|
|
487 (Check-Error wrong-number-of-arguments (<=))
|
|
|
488 (Check-Error wrong-number-of-arguments (>=))
|
|
|
489 (Check-Error wrong-number-of-arguments (/=))
|
|
|
490
|
|
|
491 ;; One argument always yields t
|
|
|
492 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
|
|
|
493 (Assert (eq t (= x)))
|
|
|
494 (Assert (eq t (< x)))
|
|
|
495 (Assert (eq t (> x)))
|
|
|
496 (Assert (eq t (>= x)))
|
|
|
497 (Assert (eq t (<= x)))
|
|
|
498 (Assert (eq t (/= x)))
|
|
|
499 )
|
|
|
500
|
|
|
501 ;; Type checking
|
|
|
502 (Check-Error wrong-type-argument (= 'foo 1))
|
|
|
503 (Check-Error wrong-type-argument (<= 'foo 1))
|
|
|
504 (Check-Error wrong-type-argument (>= 'foo 1))
|
|
|
505 (Check-Error wrong-type-argument (< 'foo 1))
|
|
|
506 (Check-Error wrong-type-argument (> 'foo 1))
|
|
|
507 (Check-Error wrong-type-argument (/= 'foo 1))
|
|
|
508
|
|
|
509 ;; Meat
|
|
|
510 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
|
|
|
511 (dolist (two '(2 2.0 ?\02))
|
|
|
512 (Assert (< one two))
|
|
|
513 (Assert (<= one two))
|
|
|
514 (Assert (<= two two))
|
|
|
515 (Assert (> two one))
|
|
|
516 (Assert (>= two one))
|
|
|
517 (Assert (>= two two))
|
|
|
518 (Assert (/= one two))
|
|
|
519 (Assert (not (/= two two)))
|
|
|
520 (Assert (not (< one one)))
|
|
|
521 (Assert (not (> one one)))
|
|
|
522 (Assert (<= one one two two))
|
|
|
523 (Assert (not (< one one two two)))
|
|
|
524 (Assert (>= two two one one))
|
|
|
525 (Assert (not (> two two one one)))
|
|
|
526 (Assert (= one one one))
|
|
|
527 (Assert (not (= one one one two)))
|
|
|
528 (Assert (not (/= one two one)))
|
|
|
529 ))
|
|
|
530
|
|
|
531 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
|
|
|
532 (dolist (two '(2 2.0 ?\02))
|
|
|
533 (Assert (< one two))
|
|
|
534 (Assert (<= one two))
|
|
|
535 (Assert (<= two two))
|
|
|
536 (Assert (> two one))
|
|
|
537 (Assert (>= two one))
|
|
|
538 (Assert (>= two two))
|
|
|
539 (Assert (/= one two))
|
|
|
540 (Assert (not (/= two two)))
|
|
|
541 (Assert (not (< one one)))
|
|
|
542 (Assert (not (> one one)))
|
|
|
543 (Assert (<= one one two two))
|
|
|
544 (Assert (not (< one one two two)))
|
|
|
545 (Assert (>= two two one one))
|
|
|
546 (Assert (not (> two two one one)))
|
|
|
547 (Assert (= one one one))
|
|
|
548 (Assert (not (= one one one two)))
|
|
|
549 (Assert (not (/= one two one)))
|
|
|
550 ))
|
|
|
551
|
|
|
552 ;; ad-hoc
|
|
|
553 (Assert (< 1 2))
|
|
|
554 (Assert (< 1 2 3 4 5 6))
|
|
|
555 (Assert (not (< 1 1)))
|
|
|
556 (Assert (not (< 2 1)))
|
|
|
557
|
|
|
558
|
|
|
559 (Assert (not (< 1 1)))
|
|
|
560 (Assert (< 1 2 3 4 5 6))
|
|
|
561 (Assert (<= 1 2 3 4 5 6))
|
|
|
562 (Assert (<= 1 2 3 4 5 6 6))
|
|
|
563 (Assert (not (< 1 2 3 4 5 6 6)))
|
|
|
564 (Assert (<= 1 1))
|
|
|
565
|
|
|
566 (Assert (not (eq (point) (point-marker))))
|
|
|
567 (Assert (= 1 (Int-to-Marker 1)))
|
|
|
568 (Assert (= (point) (point-marker)))
|
|
|
569
|
|
|
570 ;;-----------------------------------------------------
|
|
|
571 ;; testing list-walker functions
|
|
|
572 ;;-----------------------------------------------------
|
|
|
573 (macrolet
|
|
|
574 ((test-fun
|
|
|
575 (fun)
|
|
|
576 `(progn
|
|
|
577 (Check-Error wrong-number-of-arguments (,fun))
|
|
|
578 (Check-Error wrong-number-of-arguments (,fun nil))
|
|
|
579 (Check-Error malformed-list (,fun nil 1))
|
|
|
580 ,@(loop for n in '(1 2 2000)
|
|
|
581 collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
|
|
|
582 (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
|
|
|
583
|
|
|
584 (test-funs member old-member
|
|
|
585 memq old-memq
|
|
|
586 assoc old-assoc
|
|
|
587 rassoc old-rassoc
|
|
|
588 rassq old-rassq
|
|
|
589 delete old-delete
|
|
|
590 delq old-delq
|
|
|
591 remassoc remassq remrassoc remrassq))
|
|
|
592
|
|
|
593 (let ((x '((1 . 2) 3 (4 . 5))))
|
|
|
594 (Assert (eq (assoc 1 x) (car x)))
|
|
|
595 (Assert (eq (assq 1 x) (car x)))
|
|
|
596 (Assert (eq (rassoc 1 x) nil))
|
|
|
597 (Assert (eq (rassq 1 x) nil))
|
|
|
598 (Assert (eq (assoc 2 x) nil))
|
|
|
599 (Assert (eq (assq 2 x) nil))
|
|
|
600 (Assert (eq (rassoc 2 x) (car x)))
|
|
|
601 (Assert (eq (rassq 2 x) (car x)))
|
|
|
602 (Assert (eq (assoc 3 x) nil))
|
|
|
603 (Assert (eq (assq 3 x) nil))
|
|
|
604 (Assert (eq (rassoc 3 x) nil))
|
|
|
605 (Assert (eq (rassq 3 x) nil))
|
|
|
606 (Assert (eq (assoc 4 x) (caddr x)))
|
|
|
607 (Assert (eq (assq 4 x) (caddr x)))
|
|
|
608 (Assert (eq (rassoc 4 x) nil))
|
|
|
609 (Assert (eq (rassq 4 x) nil))
|
|
|
610 (Assert (eq (assoc 5 x) nil))
|
|
|
611 (Assert (eq (assq 5 x) nil))
|
|
|
612 (Assert (eq (rassoc 5 x) (caddr x)))
|
|
|
613 (Assert (eq (rassq 5 x) (caddr x)))
|
|
|
614 (Assert (eq (assoc 6 x) nil))
|
|
|
615 (Assert (eq (assq 6 x) nil))
|
|
|
616 (Assert (eq (rassoc 6 x) nil))
|
|
|
617 (Assert (eq (rassq 6 x) nil)))
|
|
|
618
|
|
|
619 (let ((x '(("1" . "2") "3" ("4" . "5"))))
|
|
|
620 (Assert (eq (assoc "1" x) (car x)))
|
|
|
621 (Assert (eq (assq "1" x) nil))
|
|
|
622 (Assert (eq (rassoc "1" x) nil))
|
|
|
623 (Assert (eq (rassq "1" x) nil))
|
|
|
624 (Assert (eq (assoc "2" x) nil))
|
|
|
625 (Assert (eq (assq "2" x) nil))
|
|
|
626 (Assert (eq (rassoc "2" x) (car x)))
|
|
|
627 (Assert (eq (rassq "2" x) nil))
|
|
|
628 (Assert (eq (assoc "3" x) nil))
|
|
|
629 (Assert (eq (assq "3" x) nil))
|
|
|
630 (Assert (eq (rassoc "3" x) nil))
|
|
|
631 (Assert (eq (rassq "3" x) nil))
|
|
|
632 (Assert (eq (assoc "4" x) (caddr x)))
|
|
|
633 (Assert (eq (assq "4" x) nil))
|
|
|
634 (Assert (eq (rassoc "4" x) nil))
|
|
|
635 (Assert (eq (rassq "4" x) nil))
|
|
|
636 (Assert (eq (assoc "5" x) nil))
|
|
|
637 (Assert (eq (assq "5" x) nil))
|
|
|
638 (Assert (eq (rassoc "5" x) (caddr x)))
|
|
|
639 (Assert (eq (rassq "5" x) nil))
|
|
|
640 (Assert (eq (assoc "6" x) nil))
|
|
|
641 (Assert (eq (assq "6" x) nil))
|
|
|
642 (Assert (eq (rassoc "6" x) nil))
|
|
|
643 (Assert (eq (rassq "6" x) nil)))
|
|
|
644
|
|
|
645 (flet ((a () (list '(1 . 2) 3 '(4 . 5))))
|
|
|
646 (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
647 (Assert (let* ((x (a)) (y (remassq 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
648 (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
|
|
|
649 (Assert (let* ((x (a)) (y (remrassq 1 x))) (and (eq x y) (equal y (a)))))
|
|
|
650
|
|
|
651 (Assert (let* ((x (a)) (y (remassoc 2 x))) (and (eq x y) (equal y (a)))))
|
|
|
652 (Assert (let* ((x (a)) (y (remassq 2 x))) (and (eq x y) (equal y (a)))))
|
|
|
653 (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
654 (Assert (let* ((x (a)) (y (remrassq 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
655
|
|
|
656 (Assert (let* ((x (a)) (y (remassoc 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
657 (Assert (let* ((x (a)) (y (remassq 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
658 (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
659 (Assert (let* ((x (a)) (y (remrassq 3 x))) (and (eq x y) (equal y (a)))))
|
|
|
660
|
|
|
661 (Assert (let* ((x (a)) (y (remassoc 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
662 (Assert (let* ((x (a)) (y (remassq 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
663 (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
|
|
|
664 (Assert (let* ((x (a)) (y (remrassq 4 x))) (and (eq x y) (equal y (a)))))
|
|
|
665
|
|
|
666 (Assert (let* ((x (a)) (y (remassoc 5 x))) (and (eq x y) (equal y (a)))))
|
|
|
667 (Assert (let* ((x (a)) (y (remassq 5 x))) (and (eq x y) (equal y (a)))))
|
|
|
668 (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
669 (Assert (let* ((x (a)) (y (remrassq 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
|
|
|
670
|
|
|
671 (Assert (let* ((x (a)) (y (remassoc 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
672 (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
673 (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
674 (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a)))))
|
|
|
675
|
|
|
676 (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
677 (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
678 (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
679 (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
|
|
|
680
|
|
|
681 (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
682 (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
|
|
|
683 (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
|
|
|
684 (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
|
|
|
685 )
|
|
|
686
|
|
|
687
|
|
|
688
|
|
|
689 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
|
|
|
690 (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
|
|
|
691 (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a)))))
|
|
|
692 (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
|
|
|
693 (Assert (let* ((x (a)) (y (remrassq "1" x))) (and (eq x y) (equal y (a)))))
|
|
|
694
|
|
|
695 (Assert (let* ((x (a)) (y (remassoc "2" x))) (and (eq x y) (equal y (a)))))
|
|
|
696 (Assert (let* ((x (a)) (y (remassq "2" x))) (and (eq x y) (equal y (a)))))
|
|
|
697 (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
|
|
|
698 (Assert (let* ((x (a)) (y (remrassq "2" x))) (and (eq x y) (equal y (a)))))
|
|
|
699
|
|
|
700 (Assert (let* ((x (a)) (y (remassoc "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
701 (Assert (let* ((x (a)) (y (remassq "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
702 (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
703 (Assert (let* ((x (a)) (y (remrassq "3" x))) (and (eq x y) (equal y (a)))))
|
|
|
704
|
|
|
705 (Assert (let* ((x (a)) (y (remassoc "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
|
|
|
706 (Assert (let* ((x (a)) (y (remassq "4" x))) (and (eq x y) (equal y (a)))))
|
|
|
707 (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
|
|
|
708 (Assert (let* ((x (a)) (y (remrassq "4" x))) (and (eq x y) (equal y (a)))))
|
|
|
709
|
|
|
710 (Assert (let* ((x (a)) (y (remassoc "5" x))) (and (eq x y) (equal y (a)))))
|
|
|
711 (Assert (let* ((x (a)) (y (remassq "5" x))) (and (eq x y) (equal y (a)))))
|
|
|
712 (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
|
|
|
713 (Assert (let* ((x (a)) (y (remrassq "5" x))) (and (eq x y) (equal y (a)))))
|
|
|
714
|
|
|
715 (Assert (let* ((x (a)) (y (remassoc "6" x))) (and (eq x y) (equal y (a)))))
|
|
|
716 (Assert (let* ((x (a)) (y (remassq "6" x))) (and (eq x y) (equal y (a)))))
|
|
|
717 (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
|
|
|
718 (Assert (let* ((x (a)) (y (remrassq "6" x))) (and (eq x y) (equal y (a))))))
|
|
|
719
|
|
|
720 ;;-----------------------------------------------------
|
|
|
721 ;; function-max-args, function-min-args
|
|
|
722 ;;-----------------------------------------------------
|
|
|
723 (defmacro check-function-argcounts (fun min max)
|
|
|
724 `(progn
|
|
|
725 (Assert (eq (function-min-args ,fun) ,min))
|
|
|
726 (Assert (eq (function-max-args ,fun) ,max))))
|
|
|
727
|
|
|
728 (check-function-argcounts 'prog1 1 nil) ; special form
|
|
|
729 (check-function-argcounts 'command-execute 1 3) ; normal subr
|
|
|
730 (check-function-argcounts 'funcall 1 nil) ; `MANY' subr
|
|
|
731 (check-function-argcounts 'garbage-collect 0 0) ; no args subr
|
|
|
732
|
|
|
733 ;; Test interpreted and compiled functions
|
|
|
734 (loop for (arglist min max) in
|
|
|
735 '(((arg1 arg2 &rest args) 2 nil)
|
|
|
736 ((arg1 arg2 &optional arg3 arg4) 2 4)
|
|
|
737 ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
|
|
|
738 (() 0 0))
|
|
|
739 do
|
|
|
740 (eval
|
|
|
741 `(progn
|
|
|
742 (defun test-fun ,arglist nil)
|
|
|
743 (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
|
|
|
744 (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
|
|
|
745
|
|
|
746 ;;-----------------------------------------------------
|
|
|
747 ;; Detection of cyclic variable indirection loops
|
|
|
748 ;;-----------------------------------------------------
|
|
|
749 (fset 'test-sym1 'test-sym1)
|
|
|
750 (Check-Error cyclic-function-indirection (test-sym1))
|
|
|
751
|
|
|
752 (fset 'test-sym1 'test-sym2)
|
|
|
753 (fset 'test-sym2 'test-sym1)
|
|
|
754 (Check-Error cyclic-function-indirection (test-sym1))
|
|
|
755 (fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
|
|
|
756 (fmakunbound 'test-sym2)
|
|
|
757
|
|
|
758 ;;-----------------------------------------------------
|
|
|
759 ;; Test `type-of'
|
|
|
760 ;;-----------------------------------------------------
|
|
|
761 (Assert (eq (type-of load-path) 'cons))
|
|
|
762 (Assert (eq (type-of obarray) 'vector))
|
|
|
763 (Assert (eq (type-of 42) 'integer))
|
|
|
764 (Assert (eq (type-of ?z) 'character))
|
|
|
765 (Assert (eq (type-of "42") 'string))
|
|
|
766 (Assert (eq (type-of 'foo) 'symbol))
|
|
|
767 (Assert (eq (type-of (selected-device)) 'device))
|
|
|
768
|
|
|
769 ;;-----------------------------------------------------
|
|
|
770 ;; Test mapping functions
|
|
|
771 ;;-----------------------------------------------------
|
|
|
772 (Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
|
|
|
773 (Assert (equal (mapcar #'identity load-path) load-path))
|
|
|
774 (Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3)))
|
|
|
775 (Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3)))
|
|
|
776 (Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3)))
|
|
|
777 (Assert (equal (mapcar #'identity #*010) '(0 1 0)))
|
|
|
778
|
|
|
779 (let ((z 0) (list (make-list 1000 1)))
|
|
|
780 (mapc (lambda (x) (incf z x)) list)
|
|
|
781 (Assert (eq 1000 z)))
|
|
|
782
|
|
|
783 (Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
|
|
|
784 (Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3]))
|
|
|
785 (Assert (equal (mapvector #'identity "123") [?1 ?2 ?3]))
|
|
|
786 (Assert (equal (mapvector #'identity [1 2 3]) [1 2 3]))
|
|
|
787 (Assert (equal (mapvector #'identity #*010) [0 1 0]))
|
|
|
788
|
|
|
789 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
|
|
|
790 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
|
|
|
791 (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3"))
|
|
|
792
|
|
434
|
793 ;; The following 2 functions used to crash XEmacs via mapcar1().
|
|
|
794 ;; We don't test the actual values of the mapcar, since they're undefined.
|
|
446
|
795 (Assert
|
|
434
|
796 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
|
|
|
797 (mapcar
|
|
|
798 (lambda (y)
|
|
|
799 "Devious evil mapping function"
|
|
|
800 (when (eq (car y) 2) ; go out onto a limb
|
|
|
801 (setcdr x nil) ; cut it off behind us
|
|
|
802 (garbage-collect)) ; are we riding a magic broomstick?
|
|
|
803 (car y)) ; sorry, hard landing
|
|
|
804 x)))
|
|
|
805
|
|
446
|
806 (Assert
|
|
434
|
807 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
|
|
|
808 (mapcar
|
|
|
809 (lambda (y)
|
|
|
810 "Devious evil mapping function"
|
|
|
811 (when (eq (car y) 1)
|
|
|
812 (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
|
|
|
813 (car y))
|
|
|
814 x)))
|
|
|
815
|
|
428
|
816 ;;-----------------------------------------------------
|
|
|
817 ;; Test vector functions
|
|
|
818 ;;-----------------------------------------------------
|
|
|
819 (Assert (equal [1 2 3] [1 2 3]))
|
|
|
820 (Assert (equal [] []))
|
|
|
821 (Assert (not (equal [1 2 3] [])))
|
|
|
822 (Assert (not (equal [1 2 3] [1 2 4])))
|
|
|
823 (Assert (not (equal [0 2 3] [1 2 3])))
|
|
|
824 (Assert (not (equal [1 2 3] [1 2 3 4])))
|
|
|
825 (Assert (not (equal [1 2 3 4] [1 2 3])))
|
|
|
826 (Assert (equal (vector 1 2 3) [1 2 3]))
|
|
|
827 (Assert (equal (make-vector 3 1) [1 1 1]))
|
|
|
828
|
|
|
829 ;;-----------------------------------------------------
|
|
|
830 ;; Test bit-vector functions
|
|
|
831 ;;-----------------------------------------------------
|
|
|
832 (Assert (equal #*010 #*010))
|
|
|
833 (Assert (equal #* #*))
|
|
|
834 (Assert (not (equal #*010 #*011)))
|
|
|
835 (Assert (not (equal #*010 #*)))
|
|
|
836 (Assert (not (equal #*110 #*010)))
|
|
|
837 (Assert (not (equal #*010 #*0100)))
|
|
|
838 (Assert (not (equal #*0101 #*010)))
|
|
|
839 (Assert (equal (bit-vector 0 1 0) #*010))
|
|
|
840 (Assert (equal (make-bit-vector 3 1) #*111))
|
|
|
841 (Assert (equal (make-bit-vector 3 0) #*000))
|
|
|
842
|
|
|
843 ;;-----------------------------------------------------
|
|
|
844 ;; Test buffer-local variables used as (ugh!) function parameters
|
|
|
845 ;;-----------------------------------------------------
|
|
|
846 (make-local-variable 'test-emacs-buffer-local-variable)
|
|
|
847 (byte-compile
|
|
|
848 (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable)
|
|
|
849 (setq test-emacs-buffer-local-variable nil)))
|
|
|
850 (test-emacs-buffer-local-parameter nil)
|
|
|
851
|
|
|
852 ;;-----------------------------------------------------
|
|
|
853 ;; Test split-string
|
|
|
854 ;;-----------------------------------------------------
|
|
1425
|
855 ;; Keep nulls, explicit SEPARATORS
|
|
|
856 ;; Hrvoje didn't like the next 3 tests so I'm disabling them for now. -sb
|
|
|
857 ;; I assume Hrvoje worried about the possibility of infloops. -sjt
|
|
|
858 (when test-harness-risk-infloops
|
|
|
859 (Assert (equal (split-string "foo" "") '("" "f" "o" "o" "")))
|
|
|
860 (Assert (equal (split-string "foo" "^") '("" "foo")))
|
|
|
861 (Assert (equal (split-string "foo" "$") '("foo" ""))))
|
|
428
|
862 (Assert (equal (split-string "foo,bar" ",") '("foo" "bar")))
|
|
|
863 (Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")))
|
|
|
864 (Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,")))
|
|
|
865 (Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" "")))
|
|
|
866 (Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")))
|
|
|
867 (Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")))
|
|
|
868 (Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")))
|
|
|
869 (Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar")))
|
|
|
870 (Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")))
|
|
1425
|
871 ;; Omit nulls, explicit SEPARATORS
|
|
|
872 (when test-harness-risk-infloops
|
|
|
873 (Assert (equal (split-string "foo" "" t) '("f" "o" "o")))
|
|
|
874 (Assert (equal (split-string "foo" "^" t) '("foo")))
|
|
|
875 (Assert (equal (split-string "foo" "$" t) '("foo"))))
|
|
|
876 (Assert (equal (split-string "foo,bar" "," t) '("foo" "bar")))
|
|
|
877 (Assert (equal (split-string ",foo,bar," "," t) '("foo" "bar")))
|
|
|
878 (Assert (equal (split-string ",foo,bar," "^," t) '("foo,bar,")))
|
|
|
879 (Assert (equal (split-string ",foo,bar," ",$" t) '(",foo,bar")))
|
|
|
880 (Assert (equal (split-string ",foo,,bar," "," t) '("foo" "bar")))
|
|
|
881 (Assert (equal (split-string "foo,,,bar" "," t) '("foo" "bar")))
|
|
|
882 (Assert (equal (split-string "foo,,bar,," "," t) '("foo" "bar")))
|
|
|
883 (Assert (equal (split-string "foo,,bar" ",+" t) '("foo" "bar")))
|
|
|
884 (Assert (equal (split-string ",foo,,bar," ",+" t) '("foo" "bar")))
|
|
|
885 ;; "Double-default" case
|
|
|
886 (Assert (equal (split-string "foo bar") '("foo" "bar")))
|
|
|
887 (Assert (equal (split-string " foo bar ") '("foo" "bar")))
|
|
|
888 (Assert (equal (split-string " foo bar ") '("foo" "bar")))
|
|
|
889 (Assert (equal (split-string "foo bar") '("foo" "bar")))
|
|
|
890 (Assert (equal (split-string "foo bar ") '("foo" "bar")))
|
|
|
891 (Assert (equal (split-string "foobar") '("foobar")))
|
|
|
892 ;; Semantics are identical to "double-default" case! Fool ya?
|
|
|
893 (Assert (equal (split-string "foo bar" nil t) '("foo" "bar")))
|
|
|
894 (Assert (equal (split-string " foo bar " nil t) '("foo" "bar")))
|
|
|
895 (Assert (equal (split-string " foo bar " nil t) '("foo" "bar")))
|
|
|
896 (Assert (equal (split-string "foo bar" nil t) '("foo" "bar")))
|
|
|
897 (Assert (equal (split-string "foo bar " nil t) '("foo" "bar")))
|
|
|
898 (Assert (equal (split-string "foobar" nil t) '("foobar")))
|
|
|
899 ;; Perverse "anti-double-default" case
|
|
|
900 (Assert (equal (split-string "foo bar" split-string-default-separators)
|
|
|
901 '("foo" "bar")))
|
|
|
902 (Assert (equal (split-string " foo bar " split-string-default-separators)
|
|
|
903 '("" "foo" "bar" "")))
|
|
|
904 (Assert (equal (split-string " foo bar " split-string-default-separators)
|
|
|
905 '("" "foo" "bar" "")))
|
|
|
906 (Assert (equal (split-string "foo bar" split-string-default-separators)
|
|
|
907 '("foo" "bar")))
|
|
|
908 (Assert (equal (split-string "foo bar " split-string-default-separators)
|
|
|
909 '("foo" "bar" "")))
|
|
|
910 (Assert (equal (split-string "foobar" split-string-default-separators)
|
|
|
911 '("foobar")))
|
|
434
|
912
|
|
442
|
913 (Assert (not (string-match "\\(\\.\\=\\)" ".")))
|
|
446
|
914 (Assert (string= "" (let ((str "test string"))
|
|
444
|
915 (if (string-match "^.*$" str)
|
|
|
916 (replace-match "\\U" t nil str)))))
|
|
|
917 (with-temp-buffer
|
|
|
918 (erase-buffer)
|
|
|
919 (insert "test string")
|
|
|
920 (re-search-backward "^.*$")
|
|
|
921 (replace-match "\\U" t)
|
|
|
922 (Assert (and (bobp) (eobp))))
|
|
442
|
923
|
|
434
|
924 ;;-----------------------------------------------------
|
|
|
925 ;; Test near-text buffer functions.
|
|
|
926 ;;-----------------------------------------------------
|
|
|
927 (with-temp-buffer
|
|
|
928 (erase-buffer)
|
|
|
929 (Assert (eq (char-before) nil))
|
|
|
930 (Assert (eq (char-before (point)) nil))
|
|
|
931 (Assert (eq (char-before (point-marker)) nil))
|
|
|
932 (Assert (eq (char-before (point) (current-buffer)) nil))
|
|
|
933 (Assert (eq (char-before (point-marker) (current-buffer)) nil))
|
|
|
934 (Assert (eq (char-after) nil))
|
|
|
935 (Assert (eq (char-after (point)) nil))
|
|
|
936 (Assert (eq (char-after (point-marker)) nil))
|
|
|
937 (Assert (eq (char-after (point) (current-buffer)) nil))
|
|
|
938 (Assert (eq (char-after (point-marker) (current-buffer)) nil))
|
|
|
939 (Assert (eq (preceding-char) 0))
|
|
|
940 (Assert (eq (preceding-char (current-buffer)) 0))
|
|
|
941 (Assert (eq (following-char) 0))
|
|
|
942 (Assert (eq (following-char (current-buffer)) 0))
|
|
|
943 (insert "foobar")
|
|
|
944 (Assert (eq (char-before) ?r))
|
|
|
945 (Assert (eq (char-after) nil))
|
|
|
946 (Assert (eq (preceding-char) ?r))
|
|
|
947 (Assert (eq (following-char) 0))
|
|
|
948 (goto-char (point-min))
|
|
|
949 (Assert (eq (char-before) nil))
|
|
|
950 (Assert (eq (char-after) ?f))
|
|
|
951 (Assert (eq (preceding-char) 0))
|
|
|
952 (Assert (eq (following-char) ?f))
|
|
|
953 )
|
|
440
|
954
|
|
|
955 ;;-----------------------------------------------------
|
|
|
956 ;; Test plist manipulation functions.
|
|
|
957 ;;-----------------------------------------------------
|
|
|
958 (let ((sym (make-symbol "test-symbol")))
|
|
|
959 (Assert (eq t (get* sym t t)))
|
|
|
960 (Assert (eq t (get sym t t)))
|
|
|
961 (Assert (eq t (getf nil t t)))
|
|
|
962 (Assert (eq t (plist-get nil t t)))
|
|
|
963 (put sym 'bar 'baz)
|
|
|
964 (Assert (eq 'baz (get sym 'bar)))
|
|
|
965 (Assert (eq 'baz (getf '(bar baz) 'bar)))
|
|
|
966 (Assert (eq 'baz (getf (symbol-plist sym) 'bar)))
|
|
|
967 (Assert (eq 2 (getf '(1 2) 1)))
|
|
442
|
968 (Assert (eq 4 (put sym 3 4)))
|
|
|
969 (Assert (eq 4 (get sym 3)))
|
|
|
970 (Assert (eq t (remprop sym 3)))
|
|
|
971 (Assert (eq nil (remprop sym 3)))
|
|
|
972 (Assert (eq 5 (get sym 3 5)))
|
|
440
|
973 )
|
|
442
|
974
|
|
|
975 (loop for obj in
|
|
|
976 (list (make-symbol "test-symbol")
|
|
|
977 "test-string"
|
|
|
978 (make-extent nil nil nil)
|
|
|
979 (make-face 'test-face))
|
|
|
980 do
|
|
|
981 (Assert (eq 2 (get obj ?1 2)))
|
|
|
982 (Assert (eq 4 (put obj ?3 4)))
|
|
|
983 (Assert (eq 4 (get obj ?3)))
|
|
|
984 (when (or (stringp obj) (symbolp obj))
|
|
|
985 (Assert (equal '(?3 4) (object-plist obj))))
|
|
|
986 (Assert (eq t (remprop obj ?3)))
|
|
|
987 (when (or (stringp obj) (symbolp obj))
|
|
|
988 (Assert (eq '() (object-plist obj))))
|
|
|
989 (Assert (eq nil (remprop obj ?3)))
|
|
|
990 (when (or (stringp obj) (symbolp obj))
|
|
|
991 (Assert (eq '() (object-plist obj))))
|
|
|
992 (Assert (eq 5 (get obj ?3 5)))
|
|
|
993 )
|
|
|
994
|
|
|
995 (Check-Error-Message
|
|
|
996 error "Object type has no properties"
|
|
|
997 (get 2 'property))
|
|
|
998
|
|
|
999 (Check-Error-Message
|
|
|
1000 error "Object type has no settable properties"
|
|
|
1001 (put (current-buffer) 'property 'value))
|
|
|
1002
|
|
|
1003 (Check-Error-Message
|
|
|
1004 error "Object type has no removable properties"
|
|
|
1005 (remprop ?3 'property))
|
|
|
1006
|
|
|
1007 (Check-Error-Message
|
|
|
1008 error "Object type has no properties"
|
|
|
1009 (object-plist (symbol-function 'car)))
|
|
|
1010
|
|
|
1011 (Check-Error-Message
|
|
|
1012 error "Can't remove property from object"
|
|
|
1013 (remprop (make-extent nil nil nil) 'detachable))
|
|
|
1014
|
|
|
1015 ;;-----------------------------------------------------
|
|
|
1016 ;; Test subseq
|
|
|
1017 ;;-----------------------------------------------------
|
|
|
1018 (Assert (equal (subseq nil 0) nil))
|
|
|
1019 (Assert (equal (subseq [1 2 3] 0) [1 2 3]))
|
|
|
1020 (Assert (equal (subseq [1 2 3] 1 -1) [2]))
|
|
|
1021 (Assert (equal (subseq "123" 0) "123"))
|
|
|
1022 (Assert (equal (subseq "1234" -3 -1) "23"))
|
|
|
1023 (Assert (equal (subseq #*0011 0) #*0011))
|
|
|
1024 (Assert (equal (subseq #*0011 -3 3) #*01))
|
|
|
1025 (Assert (equal (subseq '(1 2 3) 0) '(1 2 3)))
|
|
|
1026 (Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)))
|
|
|
1027
|
|
446
|
1028 (Check-Error wrong-type-argument (subseq 3 2))
|
|
|
1029 (Check-Error args-out-of-range (subseq [1 2 3] -42))
|
|
|
1030 (Check-Error args-out-of-range (subseq [1 2 3] 0 42))
|
|
442
|
1031
|
|
|
1032 ;;-----------------------------------------------------
|
|
|
1033 ;; Time-related tests
|
|
|
1034 ;;-----------------------------------------------------
|
|
|
1035 (Assert (= (length (current-time-string)) 24))
|
|
444
|
1036
|
|
|
1037 ;;-----------------------------------------------------
|
|
|
1038 ;; format test
|
|
|
1039 ;;-----------------------------------------------------
|
|
|
1040 (Assert (string= (format "%d" 10) "10"))
|
|
|
1041 (Assert (string= (format "%o" 8) "10"))
|
|
|
1042 (Assert (string= (format "%x" 31) "1f"))
|
|
|
1043 (Assert (string= (format "%X" 31) "1F"))
|
|
826
|
1044 ;; MS-Windows uses +002 in its floating-point numbers. #### We should
|
|
|
1045 ;; perhaps fix this, but writing our own floating-point support in doprnt.c
|
|
|
1046 ;; is very hard.
|
|
|
1047 (Assert (or (string= (format "%e" 100) "1.000000e+02")
|
|
|
1048 (string= (format "%e" 100) "1.000000e+002")))
|
|
|
1049 (Assert (or (string= (format "%E" 100) "1.000000E+02")
|
|
|
1050 (string= (format "%E" 100) "1.000000E+002")))
|
|
|
1051 (Assert (or (string= (format "%E" 100) "1.000000E+02")
|
|
|
1052 (string= (format "%E" 100) "1.000000E+002")))
|
|
444
|
1053 (Assert (string= (format "%f" 100) "100.000000"))
|
|
448
|
1054 (Assert (string= (format "%7.3f" 12.12345) " 12.123"))
|
|
|
1055 (Assert (string= (format "%07.3f" 12.12345) "012.123"))
|
|
|
1056 (Assert (string= (format "%-7.3f" 12.12345) "12.123 "))
|
|
|
1057 (Assert (string= (format "%-07.3f" 12.12345) "12.123 "))
|
|
444
|
1058 (Assert (string= (format "%g" 100.0) "100"))
|
|
826
|
1059 (Assert (or (string= (format "%g" 0.000001) "1e-06")
|
|
|
1060 (string= (format "%g" 0.000001) "1e-006")))
|
|
444
|
1061 (Assert (string= (format "%g" 0.0001) "0.0001"))
|
|
|
1062 (Assert (string= (format "%G" 100.0) "100"))
|
|
826
|
1063 (Assert (or (string= (format "%G" 0.000001) "1E-06")
|
|
|
1064 (string= (format "%G" 0.000001) "1E-006")))
|
|
444
|
1065 (Assert (string= (format "%G" 0.0001) "0.0001"))
|
|
|
1066
|
|
|
1067 (Assert (string= (format "%2$d%1$d" 10 20) "2010"))
|
|
|
1068 (Assert (string= (format "%-d" 10) "10"))
|
|
|
1069 (Assert (string= (format "%-4d" 10) "10 "))
|
|
|
1070 (Assert (string= (format "%+d" 10) "+10"))
|
|
|
1071 (Assert (string= (format "%+d" -10) "-10"))
|
|
|
1072 (Assert (string= (format "%+4d" 10) " +10"))
|
|
|
1073 (Assert (string= (format "%+4d" -10) " -10"))
|
|
|
1074 (Assert (string= (format "% d" 10) " 10"))
|
|
|
1075 (Assert (string= (format "% d" -10) "-10"))
|
|
|
1076 (Assert (string= (format "% 4d" 10) " 10"))
|
|
|
1077 (Assert (string= (format "% 4d" -10) " -10"))
|
|
|
1078 (Assert (string= (format "%0d" 10) "10"))
|
|
|
1079 (Assert (string= (format "%0d" -10) "-10"))
|
|
|
1080 (Assert (string= (format "%04d" 10) "0010"))
|
|
|
1081 (Assert (string= (format "%04d" -10) "-010"))
|
|
|
1082 (Assert (string= (format "%*d" 4 10) " 10"))
|
|
|
1083 (Assert (string= (format "%*d" 4 -10) " -10"))
|
|
|
1084 (Assert (string= (format "%*d" -4 10) "10 "))
|
|
|
1085 (Assert (string= (format "%*d" -4 -10) "-10 "))
|
|
|
1086 (Assert (string= (format "%#d" 10) "10"))
|
|
|
1087 (Assert (string= (format "%#o" 8) "010"))
|
|
|
1088 (Assert (string= (format "%#x" 16) "0x10"))
|
|
826
|
1089 (Assert (or (string= (format "%#e" 100) "1.000000e+02")
|
|
|
1090 (string= (format "%#e" 100) "1.000000e+002")))
|
|
|
1091 (Assert (or (string= (format "%#E" 100) "1.000000E+02")
|
|
|
1092 (string= (format "%#E" 100) "1.000000E+002")))
|
|
444
|
1093 (Assert (string= (format "%#f" 100) "100.000000"))
|
|
|
1094 (Assert (string= (format "%#g" 100.0) "100.000"))
|
|
826
|
1095 (Assert (or (string= (format "%#g" 0.000001) "1.00000e-06")
|
|
|
1096 (string= (format "%#g" 0.000001) "1.00000e-006")))
|
|
444
|
1097 (Assert (string= (format "%#g" 0.0001) "0.000100000"))
|
|
|
1098 (Assert (string= (format "%#G" 100.0) "100.000"))
|
|
826
|
1099 (Assert (or (string= (format "%#G" 0.000001) "1.00000E-06")
|
|
|
1100 (string= (format "%#G" 0.000001) "1.00000E-006")))
|
|
444
|
1101 (Assert (string= (format "%#G" 0.0001) "0.000100000"))
|
|
|
1102 (Assert (string= (format "%.1d" 10) "10"))
|
|
|
1103 (Assert (string= (format "%.4d" 10) "0010"))
|
|
|
1104 ;; Combination of `-', `+', ` ', `0', `#', `.', `*'
|
|
448
|
1105 (Assert (string= (format "%-04d" 10) "10 "))
|
|
444
|
1106 (Assert (string= (format "%-*d" 4 10) "10 "))
|
|
|
1107 ;; #### Correctness of this behavior is questionable.
|
|
|
1108 ;; It might be better to signal error.
|
|
|
1109 (Assert (string= (format "%-*d" -4 10) "10 "))
|
|
|
1110 ;; These behavior is not specified.
|
|
|
1111 ;; (format "%-+d" 10)
|
|
|
1112 ;; (format "%- d" 10)
|
|
|
1113 ;; (format "%-01d" 10)
|
|
|
1114 ;; (format "%-#4x" 10)
|
|
|
1115 ;; (format "%-.1d" 10)
|
|
|
1116
|
|
|
1117 (Assert (string= (format "%01.1d" 10) "10"))
|
|
448
|
1118 (Assert (string= (format "%03.1d" 10) " 10"))
|
|
|
1119 (Assert (string= (format "%01.3d" 10) "010"))
|
|
|
1120 (Assert (string= (format "%1.3d" 10) "010"))
|
|
444
|
1121 (Assert (string= (format "%3.1d" 10) " 10"))
|
|
446
|
1122
|
|
448
|
1123 ;;; The following two tests used to use 1000 instead of 100,
|
|
|
1124 ;;; but that merely found buffer overflow bugs in Solaris sprintf().
|
|
|
1125 (Assert (= 102 (length (format "%.100f" 3.14))))
|
|
|
1126 (Assert (= 100 (length (format "%100f" 3.14))))
|
|
|
1127
|
|
446
|
1128 ;;; Check for 64-bit cleanness on LP64 platforms.
|
|
|
1129 (Assert (= (read (format "%d" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1130 (Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1131 (Assert (= (read (format "%u" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1132 (Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum))
|
|
|
1133 (Assert (= (read (format "%d" most-negative-fixnum)) most-negative-fixnum))
|
|
|
1134 (Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum))
|
|
|
1135
|
|
|
1136 ;;; "%u" is undocumented, and Emacs Lisp has no unsigned type.
|
|
|
1137 ;;; What to do if "%u" is used with a negative number?
|
|
|
1138 ;;; The most reasonable thing seems to be to print an un-read-able number.
|
|
|
1139 ;;; The printed value might be useful to a human, if not to Emacs Lisp.
|
|
|
1140 (Check-Error invalid-read-syntax (read (format "%u" most-negative-fixnum)))
|
|
|
1141 (Check-Error invalid-read-syntax (read (format "%u" -1)))
|
|
448
|
1142
|
|
|
1143 ;; Check all-completions ignore element start with space.
|
|
|
1144 (Assert (not (all-completions "" '((" hidden" . "object")))))
|
|
|
1145 (Assert (all-completions " " '((" hidden" . "object"))))
|
