|
444
|
1 ;;; ccl-tests.el --- Testsuites on CCL ; -*- coding: iso-2022-7bit -*-
|
|
|
2
|
|
|
3 ;; Copyright (C) 2000 MIYASHITA Hisashi
|
|
|
4
|
|
|
5 ;; This file is part of XEmacs.
|
|
|
6
|
|
|
7 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
8 ;; under the terms of the GNU General Public License as published by
|
|
|
9 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
10 ;; any later version.
|
|
|
11
|
|
|
12 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
15 ;; General Public License for more details.
|
|
|
16
|
|
|
17 ;; You should have received a copy of the GNU General Public License
|
|
|
18 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
19 ;; Software Foundation,59 Temple Place - Suite 330,
|
|
|
20 ;; Boston, MA 02111-1307, USA.
|
|
|
21
|
|
|
22 ;;; Section 0. Useful functions to construct test suites.
|
|
|
23
|
|
|
24 (defvar ccl-test-last-register-state nil)
|
|
|
25
|
|
|
26 (defun ccl-test-register-ccl-program (sym prog)
|
|
|
27 (let ((compiled (ccl-compile prog)))
|
|
|
28 (register-ccl-program sym compiled)
|
|
|
29 compiled))
|
|
|
30
|
|
|
31 (defun ccl-test (prog &optional regs return-reg-idx)
|
|
|
32 (ccl-test-register-ccl-program
|
|
|
33 'ccl-test prog)
|
|
|
34 (cond ((< (length regs) 8)
|
|
|
35 (setq ccl-test-last-register-state
|
|
|
36 (apply #'vector (append regs (make-list (- 8 (length regs)) 0)))))
|
|
|
37 ((> (length regs) 8)
|
|
|
38 (setq ccl-test-last-register-state
|
|
|
39 (apply #'vector (subseq regs 0 8))))
|
|
|
40 (t
|
|
|
41 (setq ccl-test-last-register-state
|
|
|
42 (apply #'vector regs))))
|
|
|
43 (ccl-execute
|
|
|
44 'ccl-test
|
|
|
45 ccl-test-last-register-state)
|
|
|
46 (if (null return-reg-idx)
|
|
|
47 (setq return-reg-idx 0))
|
|
|
48 (aref ccl-test-last-register-state return-reg-idx))
|
|
|
49
|
|
|
50 (defun ccl-test-on-stream (prog string
|
|
|
51 &optional not-check-coding-system)
|
|
|
52 (ccl-test-register-ccl-program
|
|
|
53 'ccl-test-decoder prog)
|
|
|
54 (setq ccl-test-last-register-state (make-vector 9 0))
|
|
|
55 (let ((str2
|
|
|
56 (ccl-execute-on-string
|
|
|
57 'ccl-test-decoder
|
|
|
58 ccl-test-last-register-state
|
|
|
59 string)))
|
|
|
60 (if (not not-check-coding-system)
|
|
|
61 (Assert (string=
|
|
|
62 str2
|
|
|
63 (decode-coding-string
|
|
|
64 string 'ccl-test-coding-system))))
|
|
|
65 str2))
|
|
|
66
|
|
|
67 (defvar ccl-test-symbol-idx 0)
|
|
|
68 (defun ccl-test-generate-symbol (idx)
|
|
|
69 (intern (format "ccl-test-map-sym-%d" idx)))
|
|
|
70
|
|
|
71 (defun ccl-test-construct-map-structure (maps &optional idx)
|
|
|
72 (setq ccl-test-symbol-idx (if idx idx 0))
|
|
|
73 (let (map result sym)
|
|
|
74 (while maps
|
|
|
75 (setq map (car maps)
|
|
|
76 maps (cdr maps))
|
|
|
77 (cond ((vectorp map)
|
|
|
78 (setq sym (ccl-test-generate-symbol
|
|
|
79 ccl-test-symbol-idx)
|
|
|
80 ccl-test-symbol-idx
|
|
|
81 (1+ ccl-test-symbol-idx))
|
|
|
82 (register-code-conversion-map
|
|
|
83 sym map)
|
|
|
84 (set sym map)
|
|
|
85 (setq result (cons sym result)))
|
|
|
86
|
|
|
87 ((symbolp map)
|
|
|
88 (setq result (cons sym result)))
|
|
|
89
|
|
|
90 ((consp map)
|
|
|
91 (setq result
|
|
|
92 (cons (ccl-test-construct-map-structure
|
|
|
93 map ccl-test-symbol-idx)
|
|
|
94 result)))
|
|
|
95 (t
|
|
|
96 (error "Unknown data:%S" map))))
|
|
|
97 (nreverse result)))
|
|
|
98
|
|
|
99 (defun ccl-test-map-multiple (val maps)
|
|
|
100 (ccl-test
|
|
|
101 `(0 ((map-multiple
|
|
|
102 r1 r0
|
|
|
103 ,(ccl-test-construct-map-structure maps))))
|
|
|
104 (list val))
|
|
|
105 (cons (aref ccl-test-last-register-state 0)
|
|
|
106 (aref ccl-test-last-register-state 1)))
|
|
|
107
|
|
|
108 (defun ccl-test-iterate-multiple-map (val maps)
|
|
|
109 (ccl-test
|
|
|
110 `(0 ((iterate-multiple-map
|
|
|
111 r1 r0
|
|
|
112 ,@(ccl-test-construct-map-structure maps))))
|
|
|
113 (list val))
|
|
|
114 (cons (aref ccl-test-last-register-state 0)
|
|
|
115 (aref ccl-test-last-register-state 1)))
|
|
|
116
|
|
|
117 (defun ccl-test-setup ()
|
|
|
118 (define-ccl-program
|
|
|
119 ccl-test-decoder
|
|
|
120 '(1 (read r0)
|
|
|
121 (loop
|
|
|
122 (write-read-repeat r0))))
|
|
|
123 (define-ccl-program
|
|
|
124 ccl-test-encoder
|
|
|
125 '(1 (read r0)
|
|
|
126 (loop
|
|
|
127 (write-read-repeat r0))))
|
|
771
|
128 (or (find-coding-system 'ccl-test-coding-system)
|
|
|
129 (make-coding-system
|
|
|
130 'ccl-test-coding-system
|
|
|
131 'ccl
|
|
|
132 "CCL TEST temprary coding-system."
|
|
|
133 '(mnemonic "CCL-TEST"
|
|
|
134 eol-type lf
|
|
|
135 decode ccl-test-decoder
|
|
|
136 encode ccl-test-encoder))))
|
|
444
|
137
|
|
|
138 ;;; Section 1. arithmetic operations.
|
|
|
139
|
|
|
140 (defun ccl-test-normal-expr ()
|
|
|
141 ;; normal-expr
|
|
|
142 (let ((r0 0) (r1 10) (r2 20) (r3 21) (r4 7))
|
|
|
143 (Assert (= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2))))
|
|
|
144 (list r0 r1 r2 r3 r4))
|
|
|
145 (ash (% (+ (* r1 r2) r3) r4) 2))))
|
|
|
146
|
|
|
147 (Assert (\= (ccl-test '(0 ((r2 = (r1 < 10))
|
|
|
148 (r0 = (r2 > 10))))
|
|
|
149 '(0 5))
|
|
|
150 0))
|
|
|
151
|
|
|
152 (let ((r0 0) (r1 #x10FF) (r2 #xCC) (r3 #xE0))
|
|
|
153 (Assert (= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3))))
|
|
|
154 (list r0 r1 r2 r3))
|
|
|
155 (logior (logxor (logand r1 #xFF) r2) r3))))
|
|
|
156
|
|
|
157 ;; checking range of SJIS
|
|
|
158 ;; 81(40-7E, 80-FC), 82, 9F, E0, E1, EF
|
|
|
159
|
|
|
160 (let ((hs '(#x81 #x82 #x9F #xE0 #xE1 #xEF))
|
|
|
161 func high low)
|
|
|
162 (setq func
|
|
|
163 (lambda (high low)
|
|
|
164 (let (ch c1 c2)
|
|
|
165 (setq ch (split-char (decode-shift-jis-char
|
|
|
166 (cons high low))))
|
|
|
167 (setq c1 (nth 1 ch)
|
|
|
168 c2 (nth 2 ch))
|
|
|
169 (ccl-test '(0 ((r0 = (r1 de-sjis r2))))
|
|
|
170 (list 0 high low))
|
|
|
171 (Assert (and (= c1 (aref ccl-test-last-register-state 0))
|
|
|
172 (= c2 (aref ccl-test-last-register-state 7))))
|
|
|
173 (ccl-test '(0 ((r0 = (r1 en-sjis r2))))
|
|
|
174 (list 0 c1 c2))
|
|
|
175 (Assert (and (= high (aref ccl-test-last-register-state 0))
|
|
|
176 (= low (aref ccl-test-last-register-state 7)))))))
|
|
|
177 (while (setq high (car hs))
|
|
|
178 (setq hs (cdr hs))
|
|
|
179 (setq low #x40)
|
|
|
180 (while (<= low #x7E)
|
|
|
181 (funcall func high low)
|
|
|
182 (setq low (1+ low)))
|
|
|
183 (setq low #x80)
|
|
|
184 (while (<= low #xFC)
|
|
|
185 (funcall func high low)
|
|
|
186 (setq low (1+ low)))))
|
|
|
187
|
|
|
188 ;; self-expr
|
|
|
189 (Assert (= (ccl-test '(0 ((r0 += 20)
|
|
|
190 (r0 *= 40)
|
|
|
191 (r0 -= 15)))
|
|
|
192 '(100))
|
|
|
193 (- (* (+ 100 20) 40) 15)))
|
|
|
194
|
|
|
195 ;; ref. array
|
|
|
196 (Assert (= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104])))
|
|
|
197 '(3))
|
|
|
198 103)))
|
|
|
199
|
|
|
200 ;;; Section 2. Simple read and write
|
|
|
201 (defun ccl-test-simple-read-and-write ()
|
|
|
202 ;; constant
|
|
|
203 (let* ((str "1234567890abcdefghij")
|
|
|
204 (dum (make-string 1 ?X)))
|
|
|
205 (Assert
|
|
|
206 (string= (ccl-test-on-stream
|
|
|
207 `(,(length str)
|
|
|
208 ((loop (read r0) (write ,str)))) dum)
|
|
|
209 str)))
|
|
|
210 ;; register
|
|
|
211 (let* ((str "1234567890abcdefghij"))
|
|
|
212 (Assert
|
|
|
213 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
214 (loop
|
|
|
215 (write r0)
|
|
|
216 (read r0)
|
|
|
217 (repeat))))
|
|
|
218 str)
|
|
|
219 str))
|
|
|
220 (Assert
|
|
|
221 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
222 (loop
|
|
|
223 (write-read-repeat r0))))
|
|
|
224 str)
|
|
|
225 str)))
|
|
|
226
|
|
|
227 ;; expression
|
|
|
228 (let ((str "1234567890abcdefghij")
|
|
|
229 str2 i len)
|
|
|
230 (setq str2 ""
|
|
|
231 len (length str)
|
|
|
232 i 0)
|
|
|
233 (while (< i len)
|
|
|
234 (setq str2 (concat str2 (char-to-string
|
|
|
235 (+ (char-to-int (aref str i)) 3))))
|
|
|
236 (setq i (1+ i)))
|
|
|
237 (Assert
|
|
|
238 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
239 (loop
|
|
|
240 (write (r0 + 3))
|
|
|
241 (read r0)
|
|
|
242 (repeat))))
|
|
|
243 str)
|
|
|
244 str2))
|
|
|
245 (Assert
|
|
|
246 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
247 (loop
|
|
|
248 (r0 += 3)
|
|
|
249 (write-read-repeat r0))))
|
|
|
250 str)
|
|
|
251 str2)))
|
|
|
252
|
|
|
253
|
|
|
254 ;; write via array
|
|
|
255 (let* ((str (mapconcat (lambda (x) (char-to-string (int-to-char x)))
|
|
|
256 '(0 1 2 3 4 5 6) "")))
|
|
|
257 (Assert
|
|
|
258 (string= (ccl-test-on-stream
|
|
|
259 `(1 ((read r0)
|
|
|
260 (loop
|
|
|
261 (write r0
|
|
|
262 ,(vector (make-char 'japanese-jisx0208 36 34)
|
|
|
263 (make-char 'japanese-jisx0208 36 36)
|
|
|
264 (make-char 'japanese-jisx0208 36 38)
|
|
|
265 (make-char 'japanese-jisx0208 36 40)
|
|
|
266 (make-char 'japanese-jisx0208 36 42)
|
|
|
267 (make-char 'japanese-jisx0208 36 43)
|
|
|
268 (make-char 'japanese-jisx0208 36 45)
|
|
|
269 (make-char 'japanese-jisx0208 36 47)
|
|
|
270 (make-char 'japanese-jisx0208 36 49)
|
|
|
271 (make-char 'japanese-jisx0208 36 51)))
|
|
|
272 (read r0)
|
|
|
273 (repeat))))
|
|
|
274 str t)
|
|
|
275 (mapconcat #'char-to-string
|
|
|
276 (list (make-char 'japanese-jisx0208 36 34)
|
|
|
277 (make-char 'japanese-jisx0208 36 36)
|
|
|
278 (make-char 'japanese-jisx0208 36 38)
|
|
|
279 (make-char 'japanese-jisx0208 36 40)
|
|
|
280 (make-char 'japanese-jisx0208 36 42)
|
|
|
281 (make-char 'japanese-jisx0208 36 43)
|
|
|
282 (make-char 'japanese-jisx0208 36 45))
|
|
|
283 "")))))
|
|
|
284
|
|
|
285 ;;; Section 3. read-multibyte-character, and write-multibyte-character
|
|
|
286 (defun ccl-test-read-write-multibyte-character ()
|
|
|
287 ;; simple test.
|
|
|
288 (let* ((str (concat "LMDXXX..."
|
|
|
289 (mapconcat #'char-to-string
|
|
|
290 (list (make-char 'japanese-jisx0208 36 36)
|
|
|
291 (make-char 'japanese-jisx0208 36 36)
|
|
|
292 (make-char 'japanese-jisx0208 50 67)
|
|
|
293 (make-char 'japanese-jisx0208 56 58)
|
|
|
294 (make-char 'japanese-jisx0208 72 104)
|
|
|
295 (make-char 'japanese-jisx0208 36 108)
|
|
|
296 (make-char 'japanese-jisx0208 36 70)
|
|
|
297 (make-char 'japanese-jisx0208 36 45)
|
|
|
298 (make-char 'japanese-jisx0208 36 63)
|
|
|
299 (make-char 'japanese-jisx0208 33 35))
|
|
|
300 "")
|
|
|
301 "...")))
|
|
|
302 (Assert
|
|
|
303 (string=
|
|
|
304 (ccl-test-on-stream
|
|
|
305 `(1 ((loop
|
|
|
306 (read-multibyte-character r0 r1)
|
|
|
307 (write-multibyte-character r0 r1)
|
|
|
308 (repeat))))
|
|
|
309 str t)
|
|
|
310 str)))
|
|
|
311 ;;
|
|
|
312 )
|
|
|
313
|
|
|
314 ;;; Section 4. CCL call
|
|
|
315 (defun ccl-test-ccl-call ()
|
|
|
316 ;; set up
|
|
|
317 (define-ccl-program
|
|
|
318 ccl-test-sub1
|
|
|
319 '(0
|
|
|
320 ((r5 = ?z))))
|
|
|
321 (define-ccl-program
|
|
|
322 ccl-test-sub2
|
|
|
323 '(0
|
|
|
324 ((call ccl-test-sub1)
|
|
|
325 (r0 = (r5 * 20)))))
|
|
|
326 (define-ccl-program
|
|
|
327 ccl-test-sub3
|
|
|
328 '(1
|
|
|
329 ((call ccl-test-sub2)
|
|
|
330 (write r5)
|
|
|
331 (write (r0 / 20)))))
|
|
|
332 (Assert (string=
|
|
|
333 (ccl-test-on-stream
|
|
|
334 '(1 ((loop (read r0) (call ccl-test-sub3))))
|
|
|
335 "A")
|
|
|
336 "zz")))
|
|
|
337
|
|
|
338 ;;; Section 5. Map-instructions
|
|
|
339 (defun ccl-test-map-instructions ()
|
|
|
340 ;; set up
|
|
|
341 (define-ccl-program
|
|
|
342 ccl-test-arith-1
|
|
|
343 '(0
|
|
|
344 ((r0 += 1000000))))
|
|
|
345
|
|
|
346 (define-ccl-program
|
|
|
347 ccl-test-lambda
|
|
|
348 '(0
|
|
|
349 ((r0 = -3))))
|
|
|
350
|
|
|
351 (define-ccl-program
|
|
|
352 ccl-test-t
|
|
|
353 '(0
|
|
|
354 ((r0 = -2))))
|
|
|
355
|
|
|
356 (define-ccl-program
|
|
|
357 ccl-test-nil
|
|
|
358 '(0
|
|
|
359 ((r0 = -1))))
|
|
|
360
|
|
|
361 ;; 1-level normal 1 mapping
|
|
|
362 (Assert (equal
|
|
|
363 (mapcar
|
|
|
364 (lambda (val)
|
|
|
365 (ccl-test-map-multiple
|
|
|
366 val
|
|
|
367 '([100 1 2 3 4 5])))
|
|
|
368 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
369 '((0 . -1) (99 . -1)
|
|
|
370 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
|
|
|
371 (105 . -1) (106 . -1) (107 . -1))))
|
|
|
372
|
|
|
373 (Assert (equal
|
|
|
374 (mapcar
|
|
|
375 (lambda (val)
|
|
|
376 (ccl-test-iterate-multiple-map
|
|
|
377 val
|
|
|
378 '([100 1 2 3 4 5])))
|
|
|
379 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
380 '((0 . -1) (99 . -1)
|
|
|
381 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
|
|
|
382 (105 . -1) (106 . -1) (107 . -1))))
|
|
|
383
|
|
|
384 ;; 1-level normal 2 mappings
|
|
|
385 (Assert (equal
|
|
|
386 (mapcar
|
|
|
387 (lambda (val)
|
|
|
388 (ccl-test-map-multiple
|
|
|
389 val
|
|
|
390 '([100 1 2 nil 4 5]
|
|
|
391 [101 12 13 14 15 16 17])))
|
|
|
392 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
393 '((0 . -1) (99 . -1) (1 . 0) (2 . 0)
|
|
|
394 (13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1)
|
|
|
395 (107 . -1))))
|
|
|
396
|
|
|
397 (Assert (equal
|
|
|
398 (mapcar
|
|
|
399 (lambda (val)
|
|
|
400 (ccl-test-iterate-multiple-map
|
|
|
401 val
|
|
|
402 '([100 1 2 3 4 5]
|
|
|
403 [101 12 13 14 15 16 17])))
|
|
|
404 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
405 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0)
|
|
|
406 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))))
|
|
|
407
|
|
|
408
|
|
|
409 ;; 1-level normal 7 mappings
|
|
|
410 (Assert (equal
|
|
|
411 (mapcar
|
|
|
412 (lambda (val)
|
|
|
413 (ccl-test-map-multiple
|
|
|
414 val
|
|
|
415 '([100 1 2 nil 4 5]
|
|
|
416 [101 12 13 14 15 16 17]
|
|
|
417 [1000 101 102 103 nil 105 106 nil 108]
|
|
|
418 [1005 1006 1007 1008 1009 1010 1011 1012]
|
|
|
419 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
420 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
421 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
422 )))
|
|
|
423 '(0 99 100 101 102 103 104 105 106 107
|
|
|
424 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
425 9999 10000 10001 10002 10003 10004
|
|
|
426 19999 20000 20001 20002 20003 20004
|
|
|
427 20005 20006))
|
|
|
428 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
429 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
430 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1)
|
|
|
431 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
|
|
|
432 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
|
|
|
433 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
|
|
|
434 (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
|
|
|
435
|
|
|
436 (Assert (equal
|
|
|
437 (mapcar
|
|
|
438 (lambda (val)
|
|
|
439 (ccl-test-iterate-multiple-map
|
|
|
440 val
|
|
|
441 '([100 1 2 nil 4 5]
|
|
|
442 [101 12 13 14 15 16 17]
|
|
|
443 [1000 101 102 103 nil 105 106 nil 108]
|
|
|
444 [1005 1006 1007 1008 1009 1010 1011 1012]
|
|
|
445 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
446 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
447 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
448 )))
|
|
|
449 '(0 99 100 101 102 103 104 105 106 107
|
|
|
450 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
451 9999 10000 10001 10002 10003 10004
|
|
|
452 19999 20000 20001 20002 20003 20004
|
|
|
453 20005 20006))
|
|
|
454 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
455 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
456 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1)
|
|
|
457 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
|
|
|
458 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
|
|
|
459 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
|
|
|
460 (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
|
|
|
461
|
|
|
462 ;; 1-level 7 mappings including CCL call
|
|
|
463
|
|
|
464 (Assert (equal
|
|
|
465 (mapcar
|
|
|
466 (lambda (val)
|
|
|
467 (ccl-test-map-multiple
|
|
|
468 val
|
|
|
469 '([100 1 2 nil 4 5]
|
|
|
470 [101 12 13 14 15 16 17]
|
|
|
471 [1000 101 ccl-test-arith-1 103 nil 105 106 ccl-test-nil 108]
|
|
|
472 [1005 1006 1007 1008 1009 ccl-test-lambda 1011 1012]
|
|
|
473 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
474 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
475 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
476 )))
|
|
|
477 '(0 99 100 101 102 103 104 105 106 107
|
|
|
478 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009
|
|
|
479 9999 10000 10001 10002 10003 10004
|
|
|
480 19999 20000 20001 20002 20003 20004
|
|
|
481 20005 20006))
|
|
|
482 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
483 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
484 (999 . -1) (101 . 2) (1001001 . 2) (103 . 2)
|
|
|
485 (1003 . -1) (105 . 2) (106 . 2) (1007 . 3) (108 . 2)
|
|
|
486 (1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1)
|
|
|
487 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
|
|
|
488 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
|
|
|
489 (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
|
|
|
490
|
|
|
491 (Assert (equal
|
|
|
492 (mapcar
|
|
|
493 (lambda (val)
|
|
|
494 (ccl-test-iterate-multiple-map
|
|
|
495 val
|
|
|
496 '([100 1 2 nil 4 5]
|
|
|
497 [101 12 13 14 15 16 17]
|
|
|
498 [1000 101 ccl-test-arith-1 103 nil 105 106 ccl-test-nil 108]
|
|
|
499 [1005 1006 1007 1008 1009 ccl-test-lambda 1011 1012]
|
|
|
500 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
501 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
502 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
503 )))
|
|
|
504 '(0 99 100 101 102 103 104 105 106 107
|
|
|
505 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009
|
|
|
506 9999 10000 10001 10002 10003 10004
|
|
|
507 19999 20000 20001 20002 20003 20004
|
|
|
508 20005 20006))
|
|
|
509 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
510 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
511 (999 . -1) (101 . 2) (1001001 . 0) (103 . 2)
|
|
|
512 (1003 . -1) (105 . 2) (106 . 2) (-1 . 0) (108 . 2)
|
|
|
513 (1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1)
|
|
|
514 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
|
|
|
515 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
|
|
|
516 (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
|
|
|
517
|
|
|
518 ;; 3-level mappings
|
|
|
519 (Assert (equal
|
|
|
520 (mapcar
|
|
|
521 (lambda (val)
|
|
|
522 (ccl-test-map-multiple
|
|
|
523 val
|
|
|
524 '([100 1 2 nil 4 5]
|
|
|
525 [101 12 13 14 15 16 17]
|
|
|
526 [1000 101 102 103 nil 105 106 nil 108]
|
|
|
527 (([1005 1006 1007 1008 1009 1010 1011 1012]
|
|
|
528 [10005 10006 20007 20008 10009 10010 10011 10012])
|
|
|
529 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
530 [1006 2006 2007 2008 2009 2010]
|
|
|
531 ([20003 30000 30010 30020 30030 30040 30050 30060]))
|
|
|
532 [t t 0 1000000]
|
|
|
533 [1008 1108 1109 1110 1111 1112 1113])))
|
|
|
534 '(0 99 100 101 102 103 104 105 106 107
|
|
|
535 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
536 1008 1009 1010 1011 1012 1013 1014
|
|
|
537 9999 10000 10001 10002 10003 10004
|
|
|
538 10005 10006 10007 10008 10009 10010
|
|
|
539 19999 20000 20001 20002 20003 20004
|
|
|
540 20005 20006))
|
|
|
541 '((0 . 11) (99 . 11) (1 . 0) (2 . 0) (13 . 1)
|
|
|
542 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . 11)
|
|
|
543 (998 . 11) (999 . 11) (101 . 2) (102 . 2)
|
|
|
544 (103 . 2) (1003 . 11) (105 . 2) (106 . 2)
|
|
|
545 (1006 . 11) (108 . 2) (1108 . 12) (1109 . 12)
|
|
|
546 (1110 . 12) (1111 . 12) (1112 . 12) (1113 . 12)
|
|
|
547 (1014 . 11) (9999 . 11) (10000 . 11) (10001 . 11)
|
|
|
548 (10002 . 11) (10003 . 11) (10004 . 11) (10005 . 11)
|
|
|
549 (30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11)
|
|
|
550 (10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11)
|
|
|
551 (20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11)
|
|
|
552 (20006 . 11))))
|
|
|
553
|
|
|
554
|
|
|
555 ;; 3-level mappings including CCL call
|
|
|
556 (Assert (equal
|
|
|
557 (mapcar
|
|
|
558 (lambda (val)
|
|
|
559 (ccl-test-map-multiple
|
|
|
560 val
|
|
|
561 '([100 1 2 nil 4 5]
|
|
|
562 [101 12 13 14 15 16 17]
|
|
|
563 [1000 101 102 103 nil ccl-test-arith-1 106 nil 108]
|
|
|
564 (([1005 1006 1007 1008 1009 1010 1011 ccl-test-arith-1
|
|
|
565 70 71 72 73]
|
|
|
566 [10005 10006 20007 20008 10009 10010 10011 10012])
|
|
|
567 [70 ccl-test-t ccl-test-lambda ccl-test-nil ccl-test-nil]
|
|
|
568 [72 lambda]
|
|
|
569 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
570 [1006 2006 2007 2008 2009 2010]
|
|
|
571 ([20003 30000 30010 ccl-test-arith-1 30030 30040
|
|
|
572 ccl-test-arith-1 30060]
|
|
|
573 [1001010 50 51 52 53 54 55]))
|
|
|
574 [t t 0 1000000]
|
|
|
575 [t ccl-test-arith-1 0 10]
|
|
|
576 [1008 1108 1109 1110 1111 1112 1113])))
|
|
|
577 '(0 99 100 101 102 103 104 105 106 107
|
|
|
578 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
579 1008 1009 1010 1011 1012 1013 1014 1015 1016
|
|
|
580 9999 10000 10001 10002 10003 10004
|
|
|
581 10005 10006 10007 10008 10009 10010
|
|
|
582 19999 20000 20001 20002 20003 20004
|
|
|
583 20005 20006))
|
|
|
584 '((1000000 . 15) (99 . 14) (1 . 0) (2 . 0) (13 . 1)
|
|
|
585 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . 14) (998 . 14)
|
|
|
586 (999 . 14) (101 . 2) (102 . 2) (103 . 2) (1003 . 14)
|
|
|
587 (1001004 . 2) (106 . 2) (1006 . 14) (108 . 2) (1108 . 16)
|
|
|
588 (1109 . 16) (1110 . 16) (51 . 13) (1112 . 16) (71 . 7)
|
|
|
589 (72 . 8) (1015 . 14) (1016 . 14) (9999 . 14) (10000 . 14)
|
|
|
590 (10001 . 14) (10002 . 14) (10003 . 14) (10004 . 14)
|
|
|
591 (10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14)
|
|
|
592 (10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14)
|
|
|
593 (20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14)
|
|
|
594 (20005 . 14) (20006 . 14))))
|
|
|
595 ;; All map-instruction tests ends here.
|
|
|
596 )
|
|
|
597
|
|
|
598 (defun ccl-test-suites ()
|
|
|
599 (ccl-test-setup)
|
|
|
600 (ccl-test-normal-expr)
|
|
|
601 (ccl-test-simple-read-and-write)
|
|
|
602 (ccl-test-read-write-multibyte-character)
|
|
|
603 (ccl-test-ccl-call)
|
|
|
604 (ccl-test-map-instructions))
|
|
|
605
|
|
|
606 ;;; start tests only when ccl-execute is enabled.
|
|
|
607 (if (fboundp 'ccl-execute)
|
|
|
608 (ccl-test-suites))
|
|
|
609
|
|
|
610 ;;; ccl-test.el ends here.
|
