|
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))))
|
|
|
128 (make-coding-system
|
|
|
129 'ccl-test-coding-system
|
|
|
130 'ccl
|
|
|
131 "CCL TEST temprary coding-system."
|
|
|
132 '(mnemonic "CCL-TEST"
|
|
|
133 eol-type lf
|
|
|
134 decode ccl-test-decoder
|
|
|
135 encode ccl-test-encoder)))
|
|
|
136
|
|
|
137 ;;; Section 1. arithmetic operations.
|
|
|
138
|
|
|
139 (defun ccl-test-normal-expr ()
|
|
|
140 ;; normal-expr
|
|
|
141 (let ((r0 0) (r1 10) (r2 20) (r3 21) (r4 7))
|
|
|
142 (Assert (= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2))))
|
|
|
143 (list r0 r1 r2 r3 r4))
|
|
|
144 (ash (% (+ (* r1 r2) r3) r4) 2))))
|
|
|
145
|
|
|
146 (Assert (\= (ccl-test '(0 ((r2 = (r1 < 10))
|
|
|
147 (r0 = (r2 > 10))))
|
|
|
148 '(0 5))
|
|
|
149 0))
|
|
|
150
|
|
|
151 (let ((r0 0) (r1 #x10FF) (r2 #xCC) (r3 #xE0))
|
|
|
152 (Assert (= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3))))
|
|
|
153 (list r0 r1 r2 r3))
|
|
|
154 (logior (logxor (logand r1 #xFF) r2) r3))))
|
|
|
155
|
|
|
156 ;; checking range of SJIS
|
|
|
157 ;; 81(40-7E, 80-FC), 82, 9F, E0, E1, EF
|
|
|
158
|
|
|
159 (let ((hs '(#x81 #x82 #x9F #xE0 #xE1 #xEF))
|
|
|
160 func high low)
|
|
|
161 (setq func
|
|
|
162 (lambda (high low)
|
|
|
163 (let (ch c1 c2)
|
|
|
164 (setq ch (split-char (decode-shift-jis-char
|
|
|
165 (cons high low))))
|
|
|
166 (setq c1 (nth 1 ch)
|
|
|
167 c2 (nth 2 ch))
|
|
|
168 (ccl-test '(0 ((r0 = (r1 de-sjis r2))))
|
|
|
169 (list 0 high low))
|
|
|
170 (Assert (and (= c1 (aref ccl-test-last-register-state 0))
|
|
|
171 (= c2 (aref ccl-test-last-register-state 7))))
|
|
|
172 (ccl-test '(0 ((r0 = (r1 en-sjis r2))))
|
|
|
173 (list 0 c1 c2))
|
|
|
174 (Assert (and (= high (aref ccl-test-last-register-state 0))
|
|
|
175 (= low (aref ccl-test-last-register-state 7)))))))
|
|
|
176 (while (setq high (car hs))
|
|
|
177 (setq hs (cdr hs))
|
|
|
178 (setq low #x40)
|
|
|
179 (while (<= low #x7E)
|
|
|
180 (funcall func high low)
|
|
|
181 (setq low (1+ low)))
|
|
|
182 (setq low #x80)
|
|
|
183 (while (<= low #xFC)
|
|
|
184 (funcall func high low)
|
|
|
185 (setq low (1+ low)))))
|
|
|
186
|
|
|
187 ;; self-expr
|
|
|
188 (Assert (= (ccl-test '(0 ((r0 += 20)
|
|
|
189 (r0 *= 40)
|
|
|
190 (r0 -= 15)))
|
|
|
191 '(100))
|
|
|
192 (- (* (+ 100 20) 40) 15)))
|
|
|
193
|
|
|
194 ;; ref. array
|
|
|
195 (Assert (= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104])))
|
|
|
196 '(3))
|
|
|
197 103)))
|
|
|
198
|
|
|
199 ;;; Section 2. Simple read and write
|
|
|
200 (defun ccl-test-simple-read-and-write ()
|
|
|
201 ;; constant
|
|
|
202 (let* ((str "1234567890abcdefghij")
|
|
|
203 (dum (make-string 1 ?X)))
|
|
|
204 (Assert
|
|
|
205 (string= (ccl-test-on-stream
|
|
|
206 `(,(length str)
|
|
|
207 ((loop (read r0) (write ,str)))) dum)
|
|
|
208 str)))
|
|
|
209 ;; register
|
|
|
210 (let* ((str "1234567890abcdefghij"))
|
|
|
211 (Assert
|
|
|
212 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
213 (loop
|
|
|
214 (write r0)
|
|
|
215 (read r0)
|
|
|
216 (repeat))))
|
|
|
217 str)
|
|
|
218 str))
|
|
|
219 (Assert
|
|
|
220 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
221 (loop
|
|
|
222 (write-read-repeat r0))))
|
|
|
223 str)
|
|
|
224 str)))
|
|
|
225
|
|
|
226 ;; expression
|
|
|
227 (let ((str "1234567890abcdefghij")
|
|
|
228 str2 i len)
|
|
|
229 (setq str2 ""
|
|
|
230 len (length str)
|
|
|
231 i 0)
|
|
|
232 (while (< i len)
|
|
|
233 (setq str2 (concat str2 (char-to-string
|
|
|
234 (+ (char-to-int (aref str i)) 3))))
|
|
|
235 (setq i (1+ i)))
|
|
|
236 (Assert
|
|
|
237 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
238 (loop
|
|
|
239 (write (r0 + 3))
|
|
|
240 (read r0)
|
|
|
241 (repeat))))
|
|
|
242 str)
|
|
|
243 str2))
|
|
|
244 (Assert
|
|
|
245 (string= (ccl-test-on-stream `(1 ((read r0)
|
|
|
246 (loop
|
|
|
247 (r0 += 3)
|
|
|
248 (write-read-repeat r0))))
|
|
|
249 str)
|
|
|
250 str2)))
|
|
|
251
|
|
|
252
|
|
|
253 ;; write via array
|
|
|
254 (let* ((str (mapconcat (lambda (x) (char-to-string (int-to-char x)))
|
|
|
255 '(0 1 2 3 4 5 6) "")))
|
|
|
256 (Assert
|
|
|
257 (string= (ccl-test-on-stream
|
|
|
258 `(1 ((read r0)
|
|
|
259 (loop
|
|
|
260 (write r0
|
|
|
261 ,(vector (make-char 'japanese-jisx0208 36 34)
|
|
|
262 (make-char 'japanese-jisx0208 36 36)
|
|
|
263 (make-char 'japanese-jisx0208 36 38)
|
|
|
264 (make-char 'japanese-jisx0208 36 40)
|
|
|
265 (make-char 'japanese-jisx0208 36 42)
|
|
|
266 (make-char 'japanese-jisx0208 36 43)
|
|
|
267 (make-char 'japanese-jisx0208 36 45)
|
|
|
268 (make-char 'japanese-jisx0208 36 47)
|
|
|
269 (make-char 'japanese-jisx0208 36 49)
|
|
|
270 (make-char 'japanese-jisx0208 36 51)))
|
|
|
271 (read r0)
|
|
|
272 (repeat))))
|
|
|
273 str t)
|
|
|
274 (mapconcat #'char-to-string
|
|
|
275 (list (make-char 'japanese-jisx0208 36 34)
|
|
|
276 (make-char 'japanese-jisx0208 36 36)
|
|
|
277 (make-char 'japanese-jisx0208 36 38)
|
|
|
278 (make-char 'japanese-jisx0208 36 40)
|
|
|
279 (make-char 'japanese-jisx0208 36 42)
|
|
|
280 (make-char 'japanese-jisx0208 36 43)
|
|
|
281 (make-char 'japanese-jisx0208 36 45))
|
|
|
282 "")))))
|
|
|
283
|
|
|
284 ;;; Section 3. read-multibyte-character, and write-multibyte-character
|
|
|
285 (defun ccl-test-read-write-multibyte-character ()
|
|
|
286 ;; simple test.
|
|
|
287 (let* ((str (concat "LMDXXX..."
|
|
|
288 (mapconcat #'char-to-string
|
|
|
289 (list (make-char 'japanese-jisx0208 36 36)
|
|
|
290 (make-char 'japanese-jisx0208 36 36)
|
|
|
291 (make-char 'japanese-jisx0208 50 67)
|
|
|
292 (make-char 'japanese-jisx0208 56 58)
|
|
|
293 (make-char 'japanese-jisx0208 72 104)
|
|
|
294 (make-char 'japanese-jisx0208 36 108)
|
|
|
295 (make-char 'japanese-jisx0208 36 70)
|
|
|
296 (make-char 'japanese-jisx0208 36 45)
|
|
|
297 (make-char 'japanese-jisx0208 36 63)
|
|
|
298 (make-char 'japanese-jisx0208 33 35))
|
|
|
299 "")
|
|
|
300 "...")))
|
|
|
301 (Assert
|
|
|
302 (string=
|
|
|
303 (ccl-test-on-stream
|
|
|
304 `(1 ((loop
|
|
|
305 (read-multibyte-character r0 r1)
|
|
|
306 (write-multibyte-character r0 r1)
|
|
|
307 (repeat))))
|
|
|
308 str t)
|
|
|
309 str)))
|
|
|
310 ;;
|
|
|
311 )
|
|
|
312
|
|
|
313 ;;; Section 4. CCL call
|
|
|
314 (defun ccl-test-ccl-call ()
|
|
|
315 ;; set up
|
|
|
316 (define-ccl-program
|
|
|
317 ccl-test-sub1
|
|
|
318 '(0
|
|
|
319 ((r5 = ?z))))
|
|
|
320 (define-ccl-program
|
|
|
321 ccl-test-sub2
|
|
|
322 '(0
|
|
|
323 ((call ccl-test-sub1)
|
|
|
324 (r0 = (r5 * 20)))))
|
|
|
325 (define-ccl-program
|
|
|
326 ccl-test-sub3
|
|
|
327 '(1
|
|
|
328 ((call ccl-test-sub2)
|
|
|
329 (write r5)
|
|
|
330 (write (r0 / 20)))))
|
|
|
331 (Assert (string=
|
|
|
332 (ccl-test-on-stream
|
|
|
333 '(1 ((loop (read r0) (call ccl-test-sub3))))
|
|
|
334 "A")
|
|
|
335 "zz")))
|
|
|
336
|
|
|
337 ;;; Section 5. Map-instructions
|
|
|
338 (defun ccl-test-map-instructions ()
|
|
|
339 ;; set up
|
|
|
340 (define-ccl-program
|
|
|
341 ccl-test-arith-1
|
|
|
342 '(0
|
|
|
343 ((r0 += 1000000))))
|
|
|
344
|
|
|
345 (define-ccl-program
|
|
|
346 ccl-test-lambda
|
|
|
347 '(0
|
|
|
348 ((r0 = -3))))
|
|
|
349
|
|
|
350 (define-ccl-program
|
|
|
351 ccl-test-t
|
|
|
352 '(0
|
|
|
353 ((r0 = -2))))
|
|
|
354
|
|
|
355 (define-ccl-program
|
|
|
356 ccl-test-nil
|
|
|
357 '(0
|
|
|
358 ((r0 = -1))))
|
|
|
359
|
|
|
360 ;; 1-level normal 1 mapping
|
|
|
361 (Assert (equal
|
|
|
362 (mapcar
|
|
|
363 (lambda (val)
|
|
|
364 (ccl-test-map-multiple
|
|
|
365 val
|
|
|
366 '([100 1 2 3 4 5])))
|
|
|
367 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
368 '((0 . -1) (99 . -1)
|
|
|
369 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
|
|
|
370 (105 . -1) (106 . -1) (107 . -1))))
|
|
|
371
|
|
|
372 (Assert (equal
|
|
|
373 (mapcar
|
|
|
374 (lambda (val)
|
|
|
375 (ccl-test-iterate-multiple-map
|
|
|
376 val
|
|
|
377 '([100 1 2 3 4 5])))
|
|
|
378 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
379 '((0 . -1) (99 . -1)
|
|
|
380 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
|
|
|
381 (105 . -1) (106 . -1) (107 . -1))))
|
|
|
382
|
|
|
383 ;; 1-level normal 2 mappings
|
|
|
384 (Assert (equal
|
|
|
385 (mapcar
|
|
|
386 (lambda (val)
|
|
|
387 (ccl-test-map-multiple
|
|
|
388 val
|
|
|
389 '([100 1 2 nil 4 5]
|
|
|
390 [101 12 13 14 15 16 17])))
|
|
|
391 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
392 '((0 . -1) (99 . -1) (1 . 0) (2 . 0)
|
|
|
393 (13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1)
|
|
|
394 (107 . -1))))
|
|
|
395
|
|
|
396 (Assert (equal
|
|
|
397 (mapcar
|
|
|
398 (lambda (val)
|
|
|
399 (ccl-test-iterate-multiple-map
|
|
|
400 val
|
|
|
401 '([100 1 2 3 4 5]
|
|
|
402 [101 12 13 14 15 16 17])))
|
|
|
403 '(0 99 100 101 102 103 104 105 106 107))
|
|
|
404 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0)
|
|
|
405 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))))
|
|
|
406
|
|
|
407
|
|
|
408 ;; 1-level normal 7 mappings
|
|
|
409 (Assert (equal
|
|
|
410 (mapcar
|
|
|
411 (lambda (val)
|
|
|
412 (ccl-test-map-multiple
|
|
|
413 val
|
|
|
414 '([100 1 2 nil 4 5]
|
|
|
415 [101 12 13 14 15 16 17]
|
|
|
416 [1000 101 102 103 nil 105 106 nil 108]
|
|
|
417 [1005 1006 1007 1008 1009 1010 1011 1012]
|
|
|
418 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
419 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
420 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
421 )))
|
|
|
422 '(0 99 100 101 102 103 104 105 106 107
|
|
|
423 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
424 9999 10000 10001 10002 10003 10004
|
|
|
425 19999 20000 20001 20002 20003 20004
|
|
|
426 20005 20006))
|
|
|
427 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
428 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
429 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1)
|
|
|
430 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
|
|
|
431 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
|
|
|
432 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
|
|
|
433 (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
|
|
|
434
|
|
|
435 (Assert (equal
|
|
|
436 (mapcar
|
|
|
437 (lambda (val)
|
|
|
438 (ccl-test-iterate-multiple-map
|
|
|
439 val
|
|
|
440 '([100 1 2 nil 4 5]
|
|
|
441 [101 12 13 14 15 16 17]
|
|
|
442 [1000 101 102 103 nil 105 106 nil 108]
|
|
|
443 [1005 1006 1007 1008 1009 1010 1011 1012]
|
|
|
444 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
445 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
446 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
447 )))
|
|
|
448 '(0 99 100 101 102 103 104 105 106 107
|
|
|
449 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
450 9999 10000 10001 10002 10003 10004
|
|
|
451 19999 20000 20001 20002 20003 20004
|
|
|
452 20005 20006))
|
|
|
453 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
454 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
455 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1)
|
|
|
456 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
|
|
|
457 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
|
|
|
458 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
|
|
|
459 (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
|
|
|
460
|
|
|
461 ;; 1-level 7 mappings including CCL call
|
|
|
462
|
|
|
463 (Assert (equal
|
|
|
464 (mapcar
|
|
|
465 (lambda (val)
|
|
|
466 (ccl-test-map-multiple
|
|
|
467 val
|
|
|
468 '([100 1 2 nil 4 5]
|
|
|
469 [101 12 13 14 15 16 17]
|
|
|
470 [1000 101 ccl-test-arith-1 103 nil 105 106 ccl-test-nil 108]
|
|
|
471 [1005 1006 1007 1008 1009 ccl-test-lambda 1011 1012]
|
|
|
472 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
473 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
474 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
475 )))
|
|
|
476 '(0 99 100 101 102 103 104 105 106 107
|
|
|
477 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009
|
|
|
478 9999 10000 10001 10002 10003 10004
|
|
|
479 19999 20000 20001 20002 20003 20004
|
|
|
480 20005 20006))
|
|
|
481 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
482 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
483 (999 . -1) (101 . 2) (1001001 . 2) (103 . 2)
|
|
|
484 (1003 . -1) (105 . 2) (106 . 2) (1007 . 3) (108 . 2)
|
|
|
485 (1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1)
|
|
|
486 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
|
|
|
487 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
|
|
|
488 (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
|
|
|
489
|
|
|
490 (Assert (equal
|
|
|
491 (mapcar
|
|
|
492 (lambda (val)
|
|
|
493 (ccl-test-iterate-multiple-map
|
|
|
494 val
|
|
|
495 '([100 1 2 nil 4 5]
|
|
|
496 [101 12 13 14 15 16 17]
|
|
|
497 [1000 101 ccl-test-arith-1 103 nil 105 106 ccl-test-nil 108]
|
|
|
498 [1005 1006 1007 1008 1009 ccl-test-lambda 1011 1012]
|
|
|
499 [10005 10006 10007 10008 10009 10010 10011 10012]
|
|
|
500 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
501 [20003 30000 30010 30020 30030 30040 30050 30060]
|
|
|
502 )))
|
|
|
503 '(0 99 100 101 102 103 104 105 106 107
|
|
|
504 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009
|
|
|
505 9999 10000 10001 10002 10003 10004
|
|
|
506 19999 20000 20001 20002 20003 20004
|
|
|
507 20005 20006))
|
|
|
508 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0)
|
|
|
509 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
|
|
|
510 (999 . -1) (101 . 2) (1001001 . 0) (103 . 2)
|
|
|
511 (1003 . -1) (105 . 2) (106 . 2) (-1 . 0) (108 . 2)
|
|
|
512 (1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1)
|
|
|
513 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
|
|
|
514 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
|
|
|
515 (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
|
|
|
516
|
|
|
517 ;; 3-level mappings
|
|
|
518 (Assert (equal
|
|
|
519 (mapcar
|
|
|
520 (lambda (val)
|
|
|
521 (ccl-test-map-multiple
|
|
|
522 val
|
|
|
523 '([100 1 2 nil 4 5]
|
|
|
524 [101 12 13 14 15 16 17]
|
|
|
525 [1000 101 102 103 nil 105 106 nil 108]
|
|
|
526 (([1005 1006 1007 1008 1009 1010 1011 1012]
|
|
|
527 [10005 10006 20007 20008 10009 10010 10011 10012])
|
|
|
528 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
529 [1006 2006 2007 2008 2009 2010]
|
|
|
530 ([20003 30000 30010 30020 30030 30040 30050 30060]))
|
|
|
531 [t t 0 1000000]
|
|
|
532 [1008 1108 1109 1110 1111 1112 1113])))
|
|
|
533 '(0 99 100 101 102 103 104 105 106 107
|
|
|
534 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
535 1008 1009 1010 1011 1012 1013 1014
|
|
|
536 9999 10000 10001 10002 10003 10004
|
|
|
537 10005 10006 10007 10008 10009 10010
|
|
|
538 19999 20000 20001 20002 20003 20004
|
|
|
539 20005 20006))
|
|
|
540 '((0 . 11) (99 . 11) (1 . 0) (2 . 0) (13 . 1)
|
|
|
541 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . 11)
|
|
|
542 (998 . 11) (999 . 11) (101 . 2) (102 . 2)
|
|
|
543 (103 . 2) (1003 . 11) (105 . 2) (106 . 2)
|
|
|
544 (1006 . 11) (108 . 2) (1108 . 12) (1109 . 12)
|
|
|
545 (1110 . 12) (1111 . 12) (1112 . 12) (1113 . 12)
|
|
|
546 (1014 . 11) (9999 . 11) (10000 . 11) (10001 . 11)
|
|
|
547 (10002 . 11) (10003 . 11) (10004 . 11) (10005 . 11)
|
|
|
548 (30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11)
|
|
|
549 (10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11)
|
|
|
550 (20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11)
|
|
|
551 (20006 . 11))))
|
|
|
552
|
|
|
553
|
|
|
554 ;; 3-level mappings including CCL call
|
|
|
555 (Assert (equal
|
|
|
556 (mapcar
|
|
|
557 (lambda (val)
|
|
|
558 (ccl-test-map-multiple
|
|
|
559 val
|
|
|
560 '([100 1 2 nil 4 5]
|
|
|
561 [101 12 13 14 15 16 17]
|
|
|
562 [1000 101 102 103 nil ccl-test-arith-1 106 nil 108]
|
|
|
563 (([1005 1006 1007 1008 1009 1010 1011 ccl-test-arith-1
|
|
|
564 70 71 72 73]
|
|
|
565 [10005 10006 20007 20008 10009 10010 10011 10012])
|
|
|
566 [70 ccl-test-t ccl-test-lambda ccl-test-nil ccl-test-nil]
|
|
|
567 [72 lambda]
|
|
|
568 [20000 20000 20001 20002 nil 20004 20005 20006]
|
|
|
569 [1006 2006 2007 2008 2009 2010]
|
|
|
570 ([20003 30000 30010 ccl-test-arith-1 30030 30040
|
|
|
571 ccl-test-arith-1 30060]
|
|
|
572 [1001010 50 51 52 53 54 55]))
|
|
|
573 [t t 0 1000000]
|
|
|
574 [t ccl-test-arith-1 0 10]
|
|
|
575 [1008 1108 1109 1110 1111 1112 1113])))
|
|
|
576 '(0 99 100 101 102 103 104 105 106 107
|
|
|
577 998 999 1000 1001 1002 1003 1004 1005 1006 1007
|
|
|
578 1008 1009 1010 1011 1012 1013 1014 1015 1016
|
|
|
579 9999 10000 10001 10002 10003 10004
|
|
|
580 10005 10006 10007 10008 10009 10010
|
|
|
581 19999 20000 20001 20002 20003 20004
|
|
|
582 20005 20006))
|
|
|
583 '((1000000 . 15) (99 . 14) (1 . 0) (2 . 0) (13 . 1)
|
|
|
584 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . 14) (998 . 14)
|
|
|
585 (999 . 14) (101 . 2) (102 . 2) (103 . 2) (1003 . 14)
|
|
|
586 (1001004 . 2) (106 . 2) (1006 . 14) (108 . 2) (1108 . 16)
|
|
|
587 (1109 . 16) (1110 . 16) (51 . 13) (1112 . 16) (71 . 7)
|
|
|
588 (72 . 8) (1015 . 14) (1016 . 14) (9999 . 14) (10000 . 14)
|
|
|
589 (10001 . 14) (10002 . 14) (10003 . 14) (10004 . 14)
|
|
|
590 (10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14)
|
|
|
591 (10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14)
|
|
|
592 (20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14)
|
|
|
593 (20005 . 14) (20006 . 14))))
|
|
|
594 ;; All map-instruction tests ends here.
|
|
|
595 )
|
|
|
596
|
|
|
597 (defun ccl-test-suites ()
|
|
|
598 (ccl-test-setup)
|
|
|
599 (ccl-test-normal-expr)
|
|
|
600 (ccl-test-simple-read-and-write)
|
|
|
601 (ccl-test-read-write-multibyte-character)
|
|
|
602 (ccl-test-ccl-call)
|
|
|
603 (ccl-test-map-instructions))
|
|
|
604
|
|
|
605 ;;; start tests only when ccl-execute is enabled.
|
|
|
606 (if (fboundp 'ccl-execute)
|
|
|
607 (ccl-test-suites))
|
|
|
608
|
|
|
609 ;;; ccl-test.el ends here.
|
