Mercurial > hg > xemacs-beta
annotate tests/automated/ccl-tests.el @ 5916:1152e0091f8c
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal.
lisp/ChangeLog addition:
2015-06-03 Aidan Kehoe <kehoea@parhasard.net>
* code-files.el (load):
Revise this to respect load-ignore-out-of-date-elc-files, rather
than leaving that to #'load-internal. Avoids a corner case where
the source and the compiled file have different, incompatible
encodings.
Move the call to #'substitute-in-file-name here.
No longer check for a zero-length filename, since #'load-internal
no longer chokes on same and errors correctly.
src/ChangeLog addition:
2015-06-03 Aidan Kehoe <kehoea@parhasard.net>
* lread.c (Fload_internal):
Delegate calling the handler and #'substitute-in-file-name to #'load.
Error correctly with a zero-length file name, instead of giving a
bus error on my machine.
Delegate the check for out-of-date ELC files to #'load,
avoiding a bug where the encoding of the ELC file and the source
file differed.
* lread.c (PRINT_LOADING_MESSAGE_1):
This is simplified, now we no longer have to talk about
out-of-date ELC files.
tests/ChangeLog addition:
2015-06-03 Aidan Kehoe <kehoea@parhasard.net>
* automated/file-tests.el:
Gross sanity check for #'load and #'load-internal with a
zero-length FILE, something that crashed until today.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 03 Jun 2015 20:13:07 +0100 |
| parents | 308d34e9f07d |
| children |
| 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
7 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
8 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
9 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
10 ;; option) any later version. |
| 444 | 11 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
12 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
15 ;; for more details. |
| 444 | 16 |
| 17 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
18 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 444 | 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 | |
|
4573
baf6c66f6f47
Correct the CCL programs used by the coding system in ccl-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
771
diff
changeset
|
118 '(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
|
119 (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
|
120 (write-repeat r0)))) |
| 444 | 121 (define-ccl-program |
| 122 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
|
123 '(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
|
124 (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
|
125 (write-repeat r0)))) |
| 771 | 126 (or (find-coding-system 'ccl-test-coding-system) |
| 127 (make-coding-system | |
| 128 'ccl-test-coding-system | |
| 129 '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
|
130 "CCL TEST temporary coding-system." |
| 771 | 131 '(mnemonic "CCL-TEST" |
| 132 eol-type lf | |
|
4715
a357478dd457
Fix some test failures, mule-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4573
diff
changeset
|
133 safe-charsets t |
| 771 | 134 decode ccl-test-decoder |
| 135 encode ccl-test-encoder)))) | |
| 444 | 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)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
142 (Assert (= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2)))) |
| 444 | 143 (list r0 r1 r2 r3 r4)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
144 (ash (% (+ (* r1 r2) r3) r4) 2)))) |
| 444 | 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)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
152 (Assert (= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3)))) |
| 444 | 153 (list r0 r1 r2 r3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
154 (logior (logxor (logand r1 #xFF) r2) r3)))) |
| 444 | 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 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
188 (Assert (= (ccl-test '(0 ((r0 += 20) |
| 444 | 189 (r0 *= 40) |
| 190 (r0 -= 15))) | |
| 191 '(100)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
192 (- (* (+ 100 20) 40) 15))) |
| 444 | 193 |
| 194 ;; ref. array | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
195 (Assert (= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104]))) |
| 444 | 196 '(3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
197 103))) |
| 444 | 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 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
361 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
370 (105 . -1) (106 . -1) (107 . -1)))) |
| 444 | 371 |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
372 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
381 (105 . -1) (106 . -1) (107 . -1)))) |
| 444 | 382 |
| 383 ;; 1-level normal 2 mappings | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
384 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
394 (107 . -1)))) |
| 444 | 395 |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
396 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
405 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1)))) |
| 444 | 406 |
| 407 | |
| 408 ;; 1-level normal 7 mappings | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
409 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
433 (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))) |
| 444 | 434 |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
435 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
459 (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))) |
| 444 | 460 |
| 461 ;; 1-level 7 mappings including CCL call | |
| 462 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
463 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
488 (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))) |
| 444 | 489 |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
490 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
515 (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))) |
| 444 | 516 |
| 517 ;; 3-level mappings | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
518 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
551 (20006 . 11)))) |
| 444 | 552 |
| 553 | |
| 554 ;; 3-level mappings including CCL call | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
555 (Assert (equal |
| 444 | 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) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
593 (20005 . 14) (20006 . 14)))) |
| 444 | 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) | |
|
4573
baf6c66f6f47
Correct the CCL programs used by the coding system in ccl-tests.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
771
diff
changeset
|
603 (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
|
604 ;; 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
|
605 (ccl-test-setup)) |
| 444 | 606 |
| 607 ;;; start tests only when ccl-execute is enabled. | |
| 608 (if (fboundp 'ccl-execute) | |
| 609 (ccl-test-suites)) | |
| 610 | |
| 611 ;;; ccl-test.el ends here. |