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.
