[Emacs-diffs] master 1c8405e: * lisp/emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Fix bug#34757

[Stefan Monnier]

branch: master
commit 1c8405e33e814a372fa349313521b015c3601605
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Fix bug#34757
    
    This fix was provided by Pip Cet <address@hidden>.  It tightens the
    code that tries to recognize a bytecode sequence as being a simple
    function call (to then decompile it), which occasionally misfired.
    
    I added some minor changes found while investigating this issue.
    
    (byte-compile): Handle corner case where byte-compile-top-level returns
    a non-self-evaluating expression.
    (byte-compile-out-toplevel): Remove support for `progn` and `t` values
    of output-type which aren't used anywhere.
---
 lisp/emacs-lisp/bytecomp.el | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4315254..c3687c2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2779,7 +2779,11 @@ If FORM is a lambda or a macro, byte-compile it as a 
function."
         (setq fun (byte-compile-top-level fun nil 'eval))
         (if macro (push 'macro fun))
         (if (symbolp form)
-            (fset form fun)
+            ;; byte-compile-top-level returns an *expression* equivalent to the
+            ;; `fun' expression, so we need to evaluate it, tho normally
+            ;; this is not needed because the expression is just a constant
+            ;; byte-code object, which is self-evaluating.
+            (fset form (eval fun t))
           fun)))))))
 
 (defun byte-compile-sexp (sexp)
@@ -2981,7 +2985,6 @@ for symbols generated by the byte compiler itself."
                                     lexenv reserved-csts)
   ;; OUTPUT-TYPE advises about how form is expected to be used:
   ;;   'eval or nil    -> a single form,
-  ;;   'progn or t     -> a list of forms,
   ;;   'lambda         -> body of a lambda,
   ;;   'file           -> used at file-level.
   (let ((byte-compile--for-effect for-effect)
@@ -3012,6 +3015,7 @@ for symbols generated by the byte compiler itself."
     (byte-compile-out-toplevel byte-compile--for-effect output-type)))
 
 (defun byte-compile-out-toplevel (&optional for-effect output-type)
+  ;; OUTPUT-TYPE can be like that of `byte-compile-top-level'.
   (if for-effect
       ;; The stack is empty. Push a value to be returned from (byte-code ..).
       (if (eq (car (car byte-compile-output)) 'byte-discard)
@@ -3040,12 +3044,8 @@ for symbols generated by the byte compiler itself."
   ;; Note that even (quote foo) must be parsed just as any subr by the
   ;; interpreter, so quote should be compiled into byte-code in some contexts.
   ;; What to leave uncompiled:
-  ;;   lambda  -> never.  we used to leave it uncompiled if the body was
-  ;;              a single atom, but that causes confusion if the docstring
-  ;;              uses the (file . pos) syntax.  Besides, now that we have
-  ;;              the Lisp_Compiled type, the compiled form is faster.
+  ;;   lambda  -> never.  The compiled form is always faster.
   ;;   eval    -> atom, quote or (function atom atom atom)
-  ;;   progn   -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
   ;;   file    -> as progn, but takes both quotes and atoms, and longer forms.
   (let (rest
        (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
@@ -3075,8 +3075,9 @@ for symbols generated by the byte compiler itself."
                        (null (nthcdr 3 rest))
                        (setq tmp (get (car (car rest)) 'byte-opcode-invert))
                        (or (null (cdr rest))
-                           (and (memq output-type '(file progn t))
+                           (and (eq output-type 'file)
                                 (cdr (cdr rest))
+                                (eql (length body) (cdr (car rest))) ;bug#34757
                                 (eq (car (nth 1 rest)) 'byte-discard)
                                 (progn (setq rest (cdr rest)) t))))
                   (setq maycall nil)   ; Only allow one real function call.