git.chise.org Git - chise/xemacs-chise.git.1/blob - tests/automated/ccl-tests.el

   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.