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