Mercurial > hg > xemacs-beta
changeset 4295:eded49463f9a
[xemacs-hg @ 2007-11-29 13:37:51 by aidan]
Add round-trip tests for my fixed-width-8-bit CCL coding systems, fix a bug
with them, take out some inadvertant debugging code of mine from mule-ccl.c.
author | aidan |
---|---|
date | Thu, 29 Nov 2007 13:38:21 +0000 |
parents | 01a2c678e91f |
children | 2640be8e34c0 |
files | lisp/ChangeLog lisp/mule/mule-coding.el src/ChangeLog src/mule-ccl.c tests/ChangeLog tests/automated/mule-tests.el |
diffstat | 6 files changed, 62 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Nov 28 22:51:17 2007 +0000 +++ b/lisp/ChangeLog Thu Nov 29 13:38:21 2007 +0000 @@ -1,3 +1,14 @@ +2007-11-29 Aidan Kehoe <kehoea@parhasard.net> + + * mule/mule-coding.el (make-8-bit-generate-helper): + Don't use 128 as a magic constant, instead make a let-binding to + in in the eval-when-compile clause, and pass that bound value + through to the run-time code. Fixes a bug where the compile-time + and run-time code didn't share this value. + * mule/mule-coding.el (make-8-bit-coding-system): + Mark the coding systems created by this code as such, for the sake + of automated testing of their round-trip compatibility. + 2007-11-28 Aidan Kehoe <kehoea@parhasard.net> * simple.el:
--- a/lisp/mule/mule-coding.el Wed Nov 28 22:51:17 2007 +0000 +++ b/lisp/mule/mule-coding.el Thu Nov 29 13:38:21 2007 +0000 @@ -233,7 +233,8 @@ returns a list corresponding to such a ccl-program. If not, it returns nil. " (let ((tentative-encode-program-parts (eval-when-compile - (let* ((compiled + (let* ((vec-len 128) + (compiled (append (ccl-compile `(1 @@ -244,7 +245,10 @@ ((if (r0 == #xABAB) ;; #xBFFE is a sentinel in the compiled ;; program. - (write r1 ,(make-vector 256 #xBFFE)) + ;; #xBFFE is a sentinel in the compiled + ;; program. + ((r0 = r1 & #x7F) + (write r0 ,(make-vector vec-len #xBFFE))) ((mule-to-unicode r0 r1) (if (r0 == #xFFFD) (write #xBEEF) @@ -260,8 +264,11 @@ (lambda (entr) (eq #xBFFE entr)) first-part)))) (while compiled - (if (eq #xBFFE (cadr compiled)) - (setcdr compiled nil)) + (when (eq #xBFFE (cadr compiled)) + (assert (= vec-len (search '(#xBFFE) (cdr compiled) + :test #'/=)) nil + "Strange ccl vector length") + (setcdr compiled nil)) (setq compiled (cdr compiled))) ;; Is the generated code as we expect it to be? (assert (and (memq #xABAB first-part) @@ -271,11 +278,11 @@ compiled CCL code,\nand that the constant #xABAB is #xABAB. If that is not the case, and it appears not to be--that's why you're getting this message--it will not work. ") - (list first-part last-part)))) + (list first-part last-part vec-len)))) (charset-lower -1) (charset-upper -1) worth-trying known-charsets encode-program - other-charset-vector ucs) + other-charset-vector ucs args-out-of-range) (loop for char across decode-table do (pushnew (char-charset char) known-charsets)) @@ -311,7 +318,9 @@ worth-trying nil))) (when worth-trying - (setq other-charset-vector (make-vector 128 encode-failure-octet)) + (setq other-charset-vector + (make-vector (third tentative-encode-program-parts) + encode-failure-octet)) (loop for i from charset-lower to charset-upper do (aset other-charset-vector i (gethash (encode-char (make-char worth-trying i) @@ -611,6 +620,7 @@ description (plist-put (plist-put props 'decode decode-program) 'encode encode-program))) + (coding-system-put name '8-bit-fixed t) (coding-system-put name 'category (make-8-bit-choose-category decode-table)) (loop for alias in aliases @@ -682,6 +692,7 @@ 'encode-table-sym (symbol-value 'encode-table-sym))) ',encode-program)))) + (coding-system-put ',name '8-bit-fixed t) (coding-system-put ',name 'category ', (make-8-bit-choose-category decode-table)) ,(macroexpand `(loop for alias in ',aliases
--- a/src/ChangeLog Wed Nov 28 22:51:17 2007 +0000 +++ b/src/ChangeLog Thu Nov 29 13:38:21 2007 +0000 @@ -1,3 +1,8 @@ +2007-11-29 Aidan Kehoe <kehoea@parhasard.net> + + * mule-ccl.c (ccl_driver): + Take out a static variable I was using for debugging. + 2007-11-26 Aidan Kehoe <kehoea@parhasard.net> * doprnt.c:
--- a/src/mule-ccl.c Wed Nov 28 22:51:17 2007 +0000 +++ b/src/mule-ccl.c Thu Nov 29 13:38:21 2007 +0000 @@ -956,7 +956,6 @@ int this_ic = 0; int eof_ic = ccl->eof_ic; int eof_hit = 0; - static int ccl_driver_calls; if (ic >= eof_ic) ic = CCL_HEADER_MAIN; @@ -971,8 +970,6 @@ ccl_backtrace_idx = 0; #endif - ++ccl_driver_calls; - for (;;) { ccl_repeat:
--- a/tests/ChangeLog Wed Nov 28 22:51:17 2007 +0000 +++ b/tests/ChangeLog Thu Nov 29 13:38:21 2007 +0000 @@ -1,3 +1,9 @@ +2007-11-29 Aidan Kehoe <kehoea@parhasard.net> + + * automated/mule-tests.el: + Check the eight-bit fixed-width CCL coding systems for round-trip + compatibility with themselves. + 2007-11-26 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el:
--- a/tests/automated/mule-tests.el Wed Nov 28 22:51:17 2007 +0000 +++ b/tests/automated/mule-tests.el Thu Nov 29 13:38:21 2007 +0000 @@ -495,6 +495,28 @@ (eq (aref ccl-vector 4) (encode-char (make-char 'control-1 31) 'ucs))))) + + ;; Test the 8 bit fixed-width coding systems for round-trip + ;; compatibility with themselves. + (loop + for coding-system in (coding-system-list) + with all-possible-octets = (apply #'string + (loop for i from ?\x00 to ?\xFF + collect i)) + do + (when (and (coding-system-get coding-system '8-bit-fixed) + ;; Don't check the coding systems with autodetect, they are + ;; not round-trip compatible for the possible line-ending + ;; characters. + (string-match #r"-\(unix\|dos\|mac\)$" + (symbol-name coding-system))) + ;; These coding systems are round-trip compatible with themselves. + (Assert (equal (encode-coding-string + (decode-coding-string all-possible-octets + coding-system) + coding-system) + all-possible-octets)))) + ;;--------------------------------------------------------------- ;; Test charset-in-* functions ;;---------------------------------------------------------------