Mercurial > hg > xemacs-beta

changeset 5111:34b22f7e1815

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sat, 06 Mar 2010 21:14:08 -0600
parents b24cf478a45e (current diff) a50bd2ecce55 (diff)
children ba80cff33640 4f4672e2aa34
files lisp/ChangeLog
diffstat 4 files changed, 71 insertions(+), 67 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Mar 06 21:13:19 2010 -0600
+++ b/lisp/ChangeLog	Sat Mar 06 21:14:08 2010 -0600
@@ -7,6 +7,13 @@
 	Use the print settings from edebug.el to make backtraces not
 	be so huge.
 
+2010-03-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el (byte-compile-compiled-obj-to-list):
+	Remove this function, printing a compiled object to a string and
+	then reading back a substring is senseless, just use the
+	compiled-function slot accessor functions.
+
 2010-03-05  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el (delete-duplicates):
--- a/lisp/bytecomp.el	Sat Mar 06 21:13:19 2010 -0600
+++ b/lisp/bytecomp.el	Sat Mar 06 21:14:08 2010 -0600
@@ -2247,22 +2247,6 @@
 (defun byte-compile-file-form-defmacro (form)
   (byte-compile-file-form-defmumble form t))
 
-(defun byte-compile-compiled-obj-to-list (obj)
-  ;; #### this is fairly disgusting.  Rewrite the code instead
-  ;; so that it doesn't create compiled objects in the first place!
-  ;; Much better than creating them and then "uncreating" them
-  ;; like this.
-  (read (concat "("
-		(substring (let ((print-readably t)
-				 (print-gensym
-				  (if (and byte-compile-print-gensym
-					   (not byte-compile-emacs19-compatibility))
-				      '(t) nil))
-				 (print-gensym-alist nil))
-			     (prin1-to-string obj))
-			   2 -1)
-		")")))
-
 (defun byte-compile-file-form-defmumble (form macrop)
   (let* ((name (car (cdr form)))
 	 (this-kind (if macrop 'byte-compile-macro-environment
@@ -2330,7 +2314,14 @@
 	  (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
 			     (nth 1 form))))
     (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
-	   (code (byte-compile-byte-code-maker new-one)))
+	   (code (byte-compile-byte-code-maker new-one))
+           (docform-info
+            (cond ((atom code) ; compiled-function-p
+                   (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
+                  ((eq (car code) 'quote)
+                   (setq code new-one)
+                   (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
+                  ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))))
       (if this-one
 	  (setcdr this-one new-one)
 	(set this-kind
@@ -2339,60 +2330,37 @@
 	       (eq 'quote (car-safe code))
 	       (eq 'lambda (car-safe (nth 1 code))))
 	  (cons (car form)
-		(cons name (cdr (nth 1 code))))
+                (cons name (cdr (nth 1 code))))
 	(byte-compile-flush-pending)
 	(if (not (stringp (nth 3 form)))
-	    ;; No doc string.  Provide -1 as the "doc string index"
-	    ;; so that no element will be treated as a doc string.
-	    (byte-compile-output-docform
-	     "\n(defalias '"
-	     name
-	     (cond ((atom code)
-		    (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
-		   ((eq (car code) 'quote)
-		    (setq code new-one)
-		    (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")")))
-		   ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")"))))
-	     ;; FSF just calls `(append code nil)' here but that relies
-	     ;; on horrible C kludges in concat() that accept byte-
-	     ;; compiled objects and pretend they're vectors.
-	     (if (compiled-function-p code)
-		 (byte-compile-compiled-obj-to-list code)
-	       (append code nil))
-	     (and (atom code) byte-compile-dynamic
-		  1)
-	     nil)
-	  ;; Output the form by hand, that's much simpler than having
-	  ;; b-c-output-file-form analyze the defalias.
-	  (byte-compile-output-docform
-	   "\n(defalias '"
-	   name
-	   (cond ((atom code) ; compiled-function-p
-		  (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
-		 ((eq (car code) 'quote)
-		  (setq code new-one)
-		  (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
-		 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
-	   ;; The result of byte-compile-byte-code-maker is either a
-	   ;; compiled-function object, or a list of some kind.  If it's
-	   ;; not a cons, we must coerce it into a list of the elements
-	   ;; to be printed to the file.
-	   (if (consp code)
-	       code
-	     (nconc (list
-		     (compiled-function-arglist code)
-		     (compiled-function-instructions code)
-		     (compiled-function-constants code)
-		     (compiled-function-stack-depth code))
-		    (let ((doc (documentation code t)))
-		      (if doc (list doc)))
-		    (if (commandp code)
-			(list (nth 1 (compiled-function-interactive code))))))
-	   (and (atom code) byte-compile-dynamic
-		1)
+            ;; No doc string.  Provide -1 as the "doc string index" so that
+            ;; no element will be treated as a doc string by
+            ;; byte-compile-output-doc-form.
+            (setq docform-info (list (first docform-info) -1
+                                     (third docform-info))))
+        (byte-compile-output-docform
+         "\n(defalias '"
+         name
+         docform-info
+         ;; The result of byte-compile-byte-code-maker is either a
+         ;; compiled-function object, or a list of some kind.  If it's not a
+         ;; cons, we must coerce it into a list of the elements to be
+         ;; printed to the file.
+         (if (consp code)
+             code
+           (nconc (list
+                   (compiled-function-arglist code)
+                   (compiled-function-instructions code)
+                   (compiled-function-constants code)
+                   (compiled-function-stack-depth code)
+                   (compiled-function-doc-string code))
+                  (if (commandp code)
+                      (list (nth 1 (compiled-function-interactive code))))))
+         (and (atom code) byte-compile-dynamic
+              1)
 	   nil))
 	(princ ")" byte-compile-outbuffer)
-	nil))))
+	nil)))
 
 ;; Print Lisp object EXP in the output file, inside a comment,
 ;; and return the file position it will have.
--- a/tests/ChangeLog	Sat Mar 06 21:13:19 2010 -0600
+++ b/tests/ChangeLog	Sat Mar 06 21:14:08 2010 -0600
@@ -1,3 +1,9 @@
+2010-03-07  Stephen J. Turnbull  <stephen@xemacs.org>
+
+	* automated/mule-tests.el (string character conversion):
+	Test escape-quoted for the range U+0000 to U+00FF.
+	Inspired by Ben's patch to fix quoting of specials from C1 controls.
+
 2010-02-22  Ben Wing  <ben@xemacs.org>
 
 	* automated/syntax-tests.el:
--- a/tests/automated/mule-tests.el	Sat Mar 06 21:13:19 2010 -0600
+++ b/tests/automated/mule-tests.el	Sat Mar 06 21:14:08 2010 -0600
@@ -375,6 +375,29 @@
       (Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))
 
   ;;---------------------------------------------------------------
+  ;; Test string character conversion
+  ;;---------------------------------------------------------------
+
+  ;; #### This should test all coding systems!
+
+  (let ((all-octets (let ((s (make-string 256 ?\000)))
+		      (loop for i from (1- (length s)) downto 0 do
+			(aset s i (int-char i)))
+		      s))
+	(escape-quoted-result (let ((schar '(27 155 142 143 14 15))
+				    (s (make-string 262 ?\000))
+				    (pos 0))
+				(loop for ord from 0 to 255 do
+				  (when (member ord schar)
+				    (aset s pos ?\033)
+				    (incf pos))
+				  (aset s pos (int-char ord))
+				  (incf pos))
+				s)))
+    (Assert (string= (encode-coding-string all-octets 'escape-quoted)
+		     escape-quoted-result)))
+
+  ;;---------------------------------------------------------------
   ;; Test file-system character conversion (and, en passant, file ops)
   ;;---------------------------------------------------------------
   (let* ((dstroke (make-char 'latin-iso8859-2 80))