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
   ;;---------------------------------------------------------------