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