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.
