Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
| 4854:95c4ced5c07c | 4855:189fb67ca31a |
|---|---|
| 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) |