Mercurial > hg > xemacs-beta
diff lisp/mule/mule-coding.el @ 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 | edb00a8b4eff |
children | f4c3ffe60a4f |
line wrap: on
line diff
--- 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