Mercurial > hg > xemacs-beta

comparison tests/automated/ccl-tests.el @ 5136:0f66906b6e37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * test-harness.el (test-harness-from-buffer): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen. tests/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * automated/base64-tests.el (bt-base64-encode-string): * automated/base64-tests.el (bt-base64-decode-string): * automated/base64-tests.el (for): * automated/byte-compiler-tests.el: * automated/byte-compiler-tests.el (before-and-after-compile-equal): * automated/case-tests.el (downcase-string): * automated/case-tests.el (uni-mappings): * automated/ccl-tests.el (ccl-test-normal-expr): * automated/ccl-tests.el (ccl-test-map-instructions): * automated/ccl-tests.el (ccl-test-suites): * automated/database-tests.el (delete-database-files): * automated/extent-tests.el (let): * automated/extent-tests.el (insert): * automated/extent-tests.el (props): * automated/file-tests.el: * automated/file-tests.el (for): * automated/hash-table-tests.el (test): * automated/hash-table-tests.el (for): * automated/hash-table-tests.el (ht): * automated/hash-table-tests.el (iterations): * automated/hash-table-tests.el (h1): * automated/hash-table-tests.el (equal): * automated/hash-table-tests.el (=): * automated/lisp-tests.el: * automated/lisp-tests.el (eq): * automated/lisp-tests.el (test-setq): * automated/lisp-tests.el (my-vector): * automated/lisp-tests.el (x): * automated/lisp-tests.el (equal): * automated/lisp-tests.el (y): * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (=): * automated/lisp-tests.el (six): * automated/lisp-tests.el (three): * automated/lisp-tests.el (one): * automated/lisp-tests.el (two): * automated/lisp-tests.el (five): * automated/lisp-tests.el (test1): * automated/lisp-tests.el (division-test): * automated/lisp-tests.el (for): * automated/lisp-tests.el (check-function-argcounts): * automated/lisp-tests.el (z): * automated/lisp-tests.el (eql): * automated/lisp-tests.el (test-harness-risk-infloops): * automated/lisp-tests.el (erase-buffer): * automated/lisp-tests.el (sym): * automated/lisp-tests.el (new-char): * automated/lisp-tests.el (new-load-file-name): * automated/lisp-tests.el (cl-floor): * automated/lisp-tests.el (foo): * automated/md5-tests.el (lambda): * automated/md5-tests.el (large-string): * automated/md5-tests.el (mapcar): * automated/md5-tests.el (insert): * automated/mule-tests.el: * automated/mule-tests.el (test-chars): * automated/mule-tests.el (existing-file-name): * automated/mule-tests.el (featurep): * automated/query-coding-tests.el (featurep): * automated/regexp-tests.el: * automated/regexp-tests.el (insert): * automated/regexp-tests.el (Assert): * automated/regexp-tests.el (=): * automated/regexp-tests.el (featurep): * automated/regexp-tests.el (text): * automated/regexp-tests.el (text1): * automated/regexp-tests.el ("aáa"): * automated/regexp-tests.el (eql): * automated/search-tests.el (insert): * automated/search-tests.el (featurep): * automated/search-tests.el (let): * automated/search-tests.el (boundp): * automated/symbol-tests.el: * automated/symbol-tests.el (name): * automated/symbol-tests.el (check-weak-list-unique): * automated/symbol-tests.el (string): * automated/symbol-tests.el (list): * automated/symbol-tests.el (foo): * automated/symbol-tests.el (eq): * automated/symbol-tests.el (fresh-keyword-name): * automated/symbol-tests.el (print-gensym): * automated/symbol-tests.el (mysym): * automated/syntax-tests.el (test-forward-word): * automated/syntax-tests.el (test-backward-word): * automated/syntax-tests.el (test-syntax-table): * automated/syntax-tests.el (with-syntax-table): * automated/syntax-tests.el (Skip-Test-Unless): * automated/syntax-tests.el (with): * automated/tag-tests.el (testfile): * automated/weak-tests.el (w): * automated/weak-tests.el (p): * automated/weak-tests.el (a): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen.
author Ben Wing <ben@xemacs.org>
date Fri, 12 Mar 2010 18:27:51 -0600
parents 189fb67ca31a
children 308d34e9f07d
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5136:0f66906b6e37
139 ;;; Section 1. arithmetic operations. 139 ;;; Section 1. arithmetic operations.
140 140
141 (defun ccl-test-normal-expr () 141 (defun ccl-test-normal-expr ()
142 ;; normal-expr 142 ;; normal-expr
143 (let ((r0 0) (r1 10) (r2 20) (r3 21) (r4 7)) 143 (let ((r0 0) (r1 10) (r2 20) (r3 21) (r4 7))
144 (Assert= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2)))) 144 (Assert (= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2))))
145 (list r0 r1 r2 r3 r4)) 145 (list r0 r1 r2 r3 r4))
146 (ash (% (+ (* r1 r2) r3) r4) 2))) 146 (ash (% (+ (* r1 r2) r3) r4) 2))))
147 147
148 (Assert (\= (ccl-test '(0 ((r2 = (r1 < 10)) 148 (Assert (\= (ccl-test '(0 ((r2 = (r1 < 10))
149 (r0 = (r2 > 10)))) 149 (r0 = (r2 > 10))))
150 '(0 5)) 150 '(0 5))
151 0)) 151 0))
152 152
153 (let ((r0 0) (r1 #x10FF) (r2 #xCC) (r3 #xE0)) 153 (let ((r0 0) (r1 #x10FF) (r2 #xCC) (r3 #xE0))
154 (Assert= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3)))) 154 (Assert (= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3))))
155 (list r0 r1 r2 r3)) 155 (list r0 r1 r2 r3))
156 (logior (logxor (logand r1 #xFF) r2) r3))) 156 (logior (logxor (logand r1 #xFF) r2) r3))))
157 157
158 ;; checking range of SJIS 158 ;; checking range of SJIS
159 ;; 81(40-7E, 80-FC), 82, 9F, E0, E1, EF 159 ;; 81(40-7E, 80-FC), 82, 9F, E0, E1, EF
160 160
161 (let ((hs '(#x81 #x82 #x9F #xE0 #xE1 #xEF)) 161 (let ((hs '(#x81 #x82 #x9F #xE0 #xE1 #xEF))
185 (while (<= low #xFC) 185 (while (<= low #xFC)
186 (funcall func high low) 186 (funcall func high low)
187 (setq low (1+ low))))) 187 (setq low (1+ low)))))
188 188
189 ;; self-expr 189 ;; self-expr
190 (Assert= (ccl-test '(0 ((r0 += 20) 190 (Assert (= (ccl-test '(0 ((r0 += 20)
191 (r0 *= 40) 191 (r0 *= 40)
192 (r0 -= 15))) 192 (r0 -= 15)))
193 '(100)) 193 '(100))
194 (- (* (+ 100 20) 40) 15)) 194 (- (* (+ 100 20) 40) 15)))
195 195
196 ;; ref. array 196 ;; ref. array
197 (Assert= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104]))) 197 (Assert (= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104])))
198 '(3)) 198 '(3))
199 103)) 199 103)))
200 200
201 ;;; Section 2. Simple read and write 201 ;;; Section 2. Simple read and write
202 (defun ccl-test-simple-read-and-write () 202 (defun ccl-test-simple-read-and-write ()
203 ;; constant 203 ;; constant
204 (let* ((str "1234567890abcdefghij") 204 (let* ((str "1234567890abcdefghij")
358 ccl-test-nil 358 ccl-test-nil
359 '(0 359 '(0
360 ((r0 = -1)))) 360 ((r0 = -1))))
361 361
362 ;; 1-level normal 1 mapping 362 ;; 1-level normal 1 mapping
363 (Assert-equal 363 (Assert (equal
364 (mapcar 364 (mapcar
365 (lambda (val) 365 (lambda (val)
366 (ccl-test-map-multiple 366 (ccl-test-map-multiple
367 val 367 val
368 '([100 1 2 3 4 5]))) 368 '([100 1 2 3 4 5])))
369 '(0 99 100 101 102 103 104 105 106 107)) 369 '(0 99 100 101 102 103 104 105 106 107))
370 '((0 . -1) (99 . -1) 370 '((0 . -1) (99 . -1)
371 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) 371 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
372 (105 . -1) (106 . -1) (107 . -1))) 372 (105 . -1) (106 . -1) (107 . -1))))
373 373
374 (Assert-equal 374 (Assert (equal
375 (mapcar 375 (mapcar
376 (lambda (val) 376 (lambda (val)
377 (ccl-test-iterate-multiple-map 377 (ccl-test-iterate-multiple-map
378 val 378 val
379 '([100 1 2 3 4 5]))) 379 '([100 1 2 3 4 5])))
380 '(0 99 100 101 102 103 104 105 106 107)) 380 '(0 99 100 101 102 103 104 105 106 107))
381 '((0 . -1) (99 . -1) 381 '((0 . -1) (99 . -1)
382 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) 382 (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
383 (105 . -1) (106 . -1) (107 . -1))) 383 (105 . -1) (106 . -1) (107 . -1))))
384 384
385 ;; 1-level normal 2 mappings 385 ;; 1-level normal 2 mappings
386 (Assert-equal 386 (Assert (equal
387 (mapcar 387 (mapcar
388 (lambda (val) 388 (lambda (val)
389 (ccl-test-map-multiple 389 (ccl-test-map-multiple
390 val 390 val
391 '([100 1 2 nil 4 5] 391 '([100 1 2 nil 4 5]
392 [101 12 13 14 15 16 17]))) 392 [101 12 13 14 15 16 17])))
393 '(0 99 100 101 102 103 104 105 106 107)) 393 '(0 99 100 101 102 103 104 105 106 107))
394 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) 394 '((0 . -1) (99 . -1) (1 . 0) (2 . 0)
395 (13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1) 395 (13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1)
396 (107 . -1))) 396 (107 . -1))))
397 397
398 (Assert-equal 398 (Assert (equal
399 (mapcar 399 (mapcar
400 (lambda (val) 400 (lambda (val)
401 (ccl-test-iterate-multiple-map 401 (ccl-test-iterate-multiple-map
402 val 402 val
403 '([100 1 2 3 4 5] 403 '([100 1 2 3 4 5]
404 [101 12 13 14 15 16 17]))) 404 [101 12 13 14 15 16 17])))
405 '(0 99 100 101 102 103 104 105 106 107)) 405 '(0 99 100 101 102 103 104 105 106 107))
406 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) 406 '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0)
407 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))) 407 (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))))
408 408
409 409
410 ;; 1-level normal 7 mappings 410 ;; 1-level normal 7 mappings
411 (Assert-equal 411 (Assert (equal
412 (mapcar 412 (mapcar
413 (lambda (val) 413 (lambda (val)
414 (ccl-test-map-multiple 414 (ccl-test-map-multiple
415 val 415 val
416 '([100 1 2 nil 4 5] 416 '([100 1 2 nil 4 5]
430 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1) 430 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
431 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1) 431 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1)
432 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1) 432 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
433 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) 433 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
434 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) 434 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
435 (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))) 435 (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
436 436
437 (Assert-equal 437 (Assert (equal
438 (mapcar 438 (mapcar
439 (lambda (val) 439 (lambda (val)
440 (ccl-test-iterate-multiple-map 440 (ccl-test-iterate-multiple-map
441 val 441 val
442 '([100 1 2 nil 4 5] 442 '([100 1 2 nil 4 5]
456 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1) 456 (5 . 0) (16 . 1) (17 . 1) (107 . -1) (998 . -1)
457 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1) 457 (999 . -1) (101 . 2) (102 . 2) (103 . 2) (1003 . -1)
458 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1) 458 (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
459 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) 459 (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
460 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) 460 (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
461 (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))) 461 (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
462 462
463 ;; 1-level 7 mappings including CCL call 463 ;; 1-level 7 mappings including CCL call
464 464
465 (Assert-equal 465 (Assert (equal
466 (mapcar 466 (mapcar
467 (lambda (val) 467 (lambda (val)
468 (ccl-test-map-multiple 468 (ccl-test-map-multiple
469 val 469 val
470 '([100 1 2 nil 4 5] 470 '([100 1 2 nil 4 5]
485 (999 . -1) (101 . 2) (1001001 . 2) (103 . 2) 485 (999 . -1) (101 . 2) (1001001 . 2) (103 . 2)
486 (1003 . -1) (105 . 2) (106 . 2) (1007 . 3) (108 . 2) 486 (1003 . -1) (105 . 2) (106 . 2) (1007 . 3) (108 . 2)
487 (1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1) 487 (1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1)
488 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) 488 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
489 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5) 489 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
490 (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))) 490 (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
491 491
492 (Assert-equal 492 (Assert (equal
493 (mapcar 493 (mapcar
494 (lambda (val) 494 (lambda (val)
495 (ccl-test-iterate-multiple-map 495 (ccl-test-iterate-multiple-map
496 val 496 val
497 '([100 1 2 nil 4 5] 497 '([100 1 2 nil 4 5]
512 (999 . -1) (101 . 2) (1001001 . 0) (103 . 2) 512 (999 . -1) (101 . 2) (1001001 . 0) (103 . 2)
513 (1003 . -1) (105 . 2) (106 . 2) (-1 . 0) (108 . 2) 513 (1003 . -1) (105 . 2) (106 . 2) (-1 . 0) (108 . 2)
514 (1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1) 514 (1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1)
515 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) 515 (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
516 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5) 516 (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
517 (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))) 517 (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
518 518
519 ;; 3-level mappings 519 ;; 3-level mappings
520 (Assert-equal 520 (Assert (equal
521 (mapcar 521 (mapcar
522 (lambda (val) 522 (lambda (val)
523 (ccl-test-map-multiple 523 (ccl-test-map-multiple
524 val 524 val
525 '([100 1 2 nil 4 5] 525 '([100 1 2 nil 4 5]
548 (1014 . 11) (9999 . 11) (10000 . 11) (10001 . 11) 548 (1014 . 11) (9999 . 11) (10000 . 11) (10001 . 11)
549 (10002 . 11) (10003 . 11) (10004 . 11) (10005 . 11) 549 (10002 . 11) (10003 . 11) (10004 . 11) (10005 . 11)
550 (30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11) 550 (30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11)
551 (10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11) 551 (10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11)
552 (20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11) 552 (20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11)
553 (20006 . 11))) 553 (20006 . 11))))
554 554
555 555
556 ;; 3-level mappings including CCL call 556 ;; 3-level mappings including CCL call
557 (Assert-equal 557 (Assert (equal
558 (mapcar 558 (mapcar
559 (lambda (val) 559 (lambda (val)
560 (ccl-test-map-multiple 560 (ccl-test-map-multiple
561 val 561 val
562 '([100 1 2 nil 4 5] 562 '([100 1 2 nil 4 5]
590 (72 . 8) (1015 . 14) (1016 . 14) (9999 . 14) (10000 . 14) 590 (72 . 8) (1015 . 14) (1016 . 14) (9999 . 14) (10000 . 14)
591 (10001 . 14) (10002 . 14) (10003 . 14) (10004 . 14) 591 (10001 . 14) (10002 . 14) (10003 . 14) (10004 . 14)
592 (10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14) 592 (10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14)
593 (10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14) 593 (10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14)
594 (20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14) 594 (20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14)
595 (20005 . 14) (20006 . 14))) 595 (20005 . 14) (20006 . 14))))
596 ;; All map-instruction tests ends here. 596 ;; All map-instruction tests ends here.
597 ) 597 )
598 598
599 (defun ccl-test-suites () 599 (defun ccl-test-suites ()
600 (ccl-test-setup) 600 (ccl-test-setup)