Subject: bug#65017: closed (Re: bug#65017: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function)

From: [email-masked] (GNU bug Tracking System)
Date: Wed, 09 Aug 2023 12:28:02 +0000

Your bug report

#65017: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
65017: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=65017
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#65017: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function
From: Alan Mackenzie <[email-masked]>
To: Eric Marsden <[email-masked]>
Cc: [email-masked], [email-masked]
Date: Wed, 9 Aug 2023 12:27:04 +0000
List-Id: <debbugs-submit.debbugs.gnu.org>

Hello, Eric.

On Wed, Aug 02, 2023 at 12:28:24 +0200, Eric Marsden wrote:
> The byte-compiler seems to erroneously remove the symbol-function for 
> equal in the
> code show below.

> --- file "perturb.el" ---
> (require 'cl-lib)

> (defun foo ()
>    (cl-flet ((bar (v) (list v)))
>      (make-hash-table :test #'equal)))
> ---

> --- file "use.el" ---
> (require 'cl-lib)
> (require 'ert)

> (defun test ()
>    (cl-flet ((foo (x) (list x)))
>      (should (equal nil 42))))
> ---

> % emacs -Q --batch --eval '(byte-compile-file "perturb.el")' -l use.el 
> -f test
> Error: invalid-function (#<symbol equal at 95>)
>    mapbacktrace(#f(compiled-function (evald func args flags) #<bytecode 
> -0x84e95e6e2517821>))
>    debug-early-backtrace()
>    debug-early(error (invalid-function #<symbol equal at 95>))
>    #<symbol equal at 95>(nil 42)
>    apply(#<symbol equal at 95> (nil 42))
>    (setq value-2 (apply fn-0 args-1))
>    (unwind-protect (setq value-2 (apply fn-0 args-1)) (setq 
> form-description-4 (nconc (list '(should (equal nil 42))) (list :form 
> (cons fn-0 args-1)) (if (eql value-2 'ert-form-evaluation-aborted-3) nil 
> (list :value value-2)) (if (eql value-2 'ert-form-evaluation-aborted-3) 
> nil (let* ((-explainer- (and t (ert--get-explainer 'equal)))) (if 
> -explainer- (list :explanation (apply -explainer- args-1)) nil))))) 
> (ert--signal-should-execution form-description-4))
>    (if (unwind-protect (setq value-2 (apply fn-0 args-1)) (setq 
> form-description-4 (nconc (list '(should (equal nil 42))) (list :form 
> (cons fn-0 args-1)) (if (eql value-2 'ert-form-evaluation-aborted-3) nil 
> (list :value value-2)) (if (eql value-2 'ert-form-evaluation-aborted-3) 
> nil (let* ((-explainer- (and t (ert--get-explainer 'equal)))) (if 
> -explainer- (list :explanation (apply -explainer- args-1)) nil))))) 
> (ert--signal-should-execution form-description-4)) nil (ert-fail 
> form-description-4))

[ .... ]

>    test()
>    command-line-1(("--eval" "(byte-compile-file \"perturb.el\")" "-l" 
> "use.el" "-f" "test"))
>    command-line()
>    normal-top-level()
> Invalid function: #<symbol equal at 95>

> The byte-compiler seems to have erroneously removed the symbol-function 
> for equal.

The bug is now fixed in the master branch, and I'm closing the bug with
this post.

> In GNU Emacs 29.1 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.38,
>   cairo version 1.16.0) of 2023-08-01, modified by Debian built on
>   x86-ubc-02
> Windowing system distributor 'The X.Org Foundation', version 11.0.12201009
> System Description: Debian GNU/Linux trixie/sid

The patch I posted on Sunday, although correct, doesn't apply cleanly to
Emacs 29.1.  So I'm giving you a version of the patch which does work on
Emacs-29, and will enable you to fix the bug in your own copy of Emacs.

After applying the patch, it will be advisable/necessary to rebuild your
Emacs with

    $ make -j16 bootstrap # adjust the -j16 for your processor.

..  I think you'll know how to do this, but if you want any help with
applying the patch or running the bootstrap, feel free to send me
private email.

Here's the patch:

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index d093d95a775..a9deb53db03 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -483,8 +483,7 @@ byte-compile-recurse-toplevel
   ;; 3.2.3.1, "Processing of Top Level Forms".  The semantics are very
   ;; subtle: see test/lisp/emacs-lisp/bytecomp-tests.el for interesting
   ;; cases.
-  (let ((print-symbols-bare t))         ; Possibly redundant binding.
-    (setf form (macroexp-macroexpand form byte-compile-macro-environment)))
+  (setf form (macroexp-macroexpand form byte-compile-macro-environment))
   (if (eq (car-safe form) 'progn)
       (cons (car form)
             (mapcar (lambda (subform)
@@ -526,12 +525,11 @@ byte-compile-initial-macro-environment
                               ;; Don't compile here, since we don't know
                               ;; whether to compile as byte-compile-form
                               ;; or byte-compile-file-form.
-                              (let* ((print-symbols-bare t) ; Possibly redundant binding.
-                                     (expanded
-                                      (byte-run-strip-symbol-positions
-                                       (macroexpand--all-toplevel
-                                        form
-                                        macroexpand-all-environment))))
+                              (let ((expanded
+                                     (byte-run-strip-symbol-positions
+                                      (macroexpand--all-toplevel
+                                       form
+                                       macroexpand-all-environment))))
                                 (eval expanded lexical-binding)
                                 expanded)))))
     (with-suppressed-warnings
@@ -2436,8 +2434,7 @@ byte-compile-output-file-form
     ;; Spill output for the native compiler here
     (push (make-byte-to-native-top-level :form form :lexical lexical-binding)
           byte-to-native-top-level-forms))
-  (let ((print-symbols-bare t)          ; Possibly redundant binding.
-        (print-escape-newlines t)
+  (let ((print-escape-newlines t)
         (print-length nil)
         (print-level nil)
         (print-quoted t)
@@ -2471,8 +2468,7 @@ byte-compile-output-docform
   ;; in the input buffer (now current), not in the output buffer.
   (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
     (with-current-buffer byte-compile--outbuffer
-      (let (position
-            (print-symbols-bare t))     ; Possibly redundant binding.
+      (let (position)
         ;; Insert the doc string, and make it a comment with #@LENGTH.
         (when (and (>= (nth 1 info) 0) dynamic-docstrings)
           (setq position (byte-compile-output-as-comment
@@ -2568,8 +2564,7 @@ byte-compile-flush-pending
               byte-compile-jump-tables nil))))
 
 (defun byte-compile-preprocess (form &optional _for-effect)
-  (let ((print-symbols-bare t))         ; Possibly redundant binding.
-    (setq form (macroexpand-all form byte-compile-macro-environment)))
+  (setq form (macroexpand-all form byte-compile-macro-environment))
   ;; FIXME: We should run byte-optimize-form here, but it currently does not
   ;; recurse through all the code, so we'd have to fix this first.
   ;; Maybe a good fix would be to merge byte-optimize-form into
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 168de1bf180..6c604a75a33 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -107,8 +107,7 @@ macroexp--all-clauses
 
 (defun macroexp--compiler-macro (handler form)
   (condition-case-unless-debug err
-      (let ((symbols-with-pos-enabled t))
-        (apply handler form (cdr form)))
+      (apply handler form (cdr form))
     (error
      (message "Warning: Optimization failure for %S: Handler: %S\n%S"
               (car form) handler err)
@@ -787,40 +786,38 @@ macroexp--debug-eager
 
 (defun internal-macroexpand-for-load (form full-p)
   ;; Called from the eager-macroexpansion in readevalloop.
-  (let ((symbols-with-pos-enabled t)
-        (print-symbols-bare t))
-    (cond
-     ;; Don't repeat the same warning for every top-level element.
-     ((eq 'skip (car macroexp--pending-eager-loads)) form)
-     ;; If we detect a cycle, skip macro-expansion for now, and output a warning
-     ;; with a trimmed backtrace.
-     ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
-      (let* ((bt (delq nil
-                       (mapcar #'macroexp--trim-backtrace-frame
-                               (macroexp--backtrace))))
-             (elem `(load ,(file-name-nondirectory load-file-name)))
-             (tail (member elem (cdr (member elem bt)))))
-        (if tail (setcdr tail (list '…)))
-        (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
-        (if macroexp--debug-eager
-            (debug 'eager-macroexp-cycle)
-          (error "Eager macro-expansion skipped due to cycle:\n  %s"
-                 (mapconcat #'prin1-to-string (nreverse bt) " => ")))
-        (push 'skip macroexp--pending-eager-loads)
-        form))
-     (t
-      (condition-case err
-          (let ((macroexp--pending-eager-loads
-                 (cons load-file-name macroexp--pending-eager-loads)))
-            (if full-p
-                (macroexpand--all-toplevel form)
-              (macroexpand form)))
-        (error
-         ;; Hopefully this shouldn't happen thanks to the cycle detection,
-         ;; but in case it does happen, let's catch the error and give the
-         ;; code a chance to macro-expand later.
-         (error "Eager macro-expansion failure: %S" err)
-         form))))))
+  (cond
+   ;; Don't repeat the same warning for every top-level element.
+   ((eq 'skip (car macroexp--pending-eager-loads)) form)
+   ;; If we detect a cycle, skip macro-expansion for now, and output a warning
+   ;; with a trimmed backtrace.
+   ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
+    (let* ((bt (delq nil
+                     (mapcar #'macroexp--trim-backtrace-frame
+                             (macroexp--backtrace))))
+           (elem `(load ,(file-name-nondirectory load-file-name)))
+           (tail (member elem (cdr (member elem bt)))))
+      (if tail (setcdr tail (list '…)))
+      (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
+      (if macroexp--debug-eager
+          (debug 'eager-macroexp-cycle)
+        (error "Eager macro-expansion skipped due to cycle:\n  %s"
+               (mapconcat #'prin1-to-string (nreverse bt) " => ")))
+      (push 'skip macroexp--pending-eager-loads)
+      form))
+   (t
+    (condition-case err
+        (let ((macroexp--pending-eager-loads
+               (cons load-file-name macroexp--pending-eager-loads)))
+          (if full-p
+              (macroexpand--all-toplevel form)
+            (macroexpand form)))
+      (error
+       ;; Hopefully this shouldn't happen thanks to the cycle detection,
+       ;; but in case it does happen, let's catch the error and give the
+       ;; code a chance to macro-expand later.
+       (error "Eager macro-expansion failure: %S" err)
+       form)))))
 
 ;; ¡¡¡ Big Ugly Hack !!!
 ;; src/bootstrap-emacs is mostly used to compile .el files, so it needs

-- 
Alan Mackenzie (Nuremberg, Germany).

Subject: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function
From: Eric Marsden <[email-masked]>
To: [email-masked]
Date: Wed, 2 Aug 2023 12:28:24 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

The byte-compiler seems to erroneously remove the symbol-function for 
equal in the
code show below.

--- file "perturb.el" ---
(require 'cl-lib)

(defun foo ()
   (cl-flet ((bar (v) (list v)))
     (make-hash-table :test #'equal)))
---

--- file "use.el" ---
(require 'cl-lib)
(require 'ert)

(defun test ()
   (cl-flet ((foo (x) (list x)))
     (should (equal nil 42))))
---

% emacs -Q --batch --eval '(byte-compile-file "perturb.el")' -l use.el 
-f test
Error: invalid-function (#<symbol equal at 95>)
   mapbacktrace(#f(compiled-function (evald func args flags) #<bytecode 
-0x84e95e6e2517821>))
   debug-early-backtrace()
   debug-early(error (invalid-function #<symbol equal at 95>))
   #<symbol equal at 95>(nil 42)
   apply(#<symbol equal at 95> (nil 42))
   (setq value-2 (apply fn-0 args-1))
   (unwind-protect (setq value-2 (apply fn-0 args-1)) (setq 
form-description-4 (nconc (list '(should (equal nil 42))) (list :form 
(cons fn-0 args-1)) (if (eql value-2 'ert-form-evaluation-aborted-3) nil 
(list :value value-2)) (if (eql value-2 'ert-form-evaluation-aborted-3) 
nil (let* ((-explainer- (and t (ert--get-explainer 'equal)))) (if 
-explainer- (list :explanation (apply -explainer- args-1)) nil))))) 
(ert--signal-should-execution form-description-4))
   (if (unwind-protect (setq value-2 (apply fn-0 args-1)) (setq 
form-description-4 (nconc (list '(should (equal nil 42))) (list :form 
(cons fn-0 args-1)) (if (eql value-2 'ert-form-evaluation-aborted-3) nil 
(list :value value-2)) (if (eql value-2 'ert-form-evaluation-aborted-3) 
nil (let* ((-explainer- (and t (ert--get-explainer 'equal)))) (if 
-explainer- (list :explanation (apply -explainer- args-1)) nil))))) 
(ert--signal-should-execution form-description-4)) nil (ert-fail 
form-description-4))
   (let (form-description-4) (if (unwind-protect (setq value-2 (apply 
fn-0 args-1)) (setq form-description-4 (nconc (list '(should (equal nil 
42))) (list :form (cons fn-0 args-1)) (if (eql value-2 
'ert-form-evaluation-aborted-3) nil (list :value value-2)) (if (eql 
value-2 'ert-form-evaluation-aborted-3) nil (let* ((-explainer- (and t 
(ert--get-explainer 'equal)))) (if -explainer- (list :explanation (apply 
-explainer- args-1)) nil))))) (ert--signal-should-execution 
form-description-4)) nil (ert-fail form-description-4)))
   (let ((value-2 'ert-form-evaluation-aborted-3)) (let 
(form-description-4) (if (unwind-protect (setq value-2 (apply fn-0 
args-1)) (setq form-description-4 (nconc (list '(should (equal nil 42))) 
(list :form (cons fn-0 args-1)) (if (eql value-2 
'ert-form-evaluation-aborted-3) nil (list :value value-2)) (if (eql 
value-2 'ert-form-evaluation-aborted-3) nil (let* ((-explainer- (and t 
(ert--get-explainer 'equal)))) (if -explainer- (list :explanation (apply 
-explainer- args-1)) nil))))) (ert--signal-should-execution 
form-description-4)) nil (ert-fail form-description-4))) value-2)
   (let* ((fn-0 #'#<symbol equal at 95>) (args-1 (condition-case err 
(let ((signal-hook-function #'ert--should-signal-hook)) (list nil 42)) 
(error (progn (setq fn-0 #'signal) (list (car err) (cdr err))))))) (let 
((value-2 'ert-form-evaluation-aborted-3)) (let (form-description-4) (if 
(unwind-protect (setq value-2 (apply fn-0 args-1)) (setq 
form-description-4 (nconc (list '(should (equal nil 42))) (list :form 
(cons fn-0 args-1)) (if (eql value-2 'ert-form-evaluation-aborted-3) nil 
(list :value value-2)) (if (eql value-2 'ert-form-evaluation-aborted-3) 
nil (let* ((-explainer- (and t (ert--get-explainer 'equal)))) (if 
-explainer- (list :explanation (apply -explainer- args-1)) nil))))) 
(ert--signal-should-execution form-description-4)) nil (ert-fail 
form-description-4))) value-2))
   (progn (let* ((fn-0 #'#<symbol equal at 95>) (args-1 (condition-case 
err (let ((signal-hook-function #'ert--should-signal-hook)) (list nil 
42)) (error (progn (setq fn-0 #'signal) (list (car err) (cdr err))))))) 
(let ((value-2 'ert-form-evaluation-aborted-3)) (let 
(form-description-4) (if (unwind-protect (setq value-2 (apply fn-0 
args-1)) (setq form-description-4 (nconc (list '(should (equal nil 42))) 
(list :form (cons fn-0 args-1)) (if (eql value-2 
'ert-form-evaluation-aborted-3) nil (list :value value-2)) (if (eql 
value-2 'ert-form-evaluation-aborted-3) nil (let* ((-explainer- (and t 
(ert--get-explainer 'equal)))) (if -explainer- (list :explanation (apply 
-explainer- args-1)) nil))))) (ert--signal-should-execution 
form-description-4)) nil (ert-fail form-description-4))) value-2)))
   (let* ((--cl-foo-- #'(lambda (x) (list x)))) (progn (let* ((fn-0 
#'#<symbol equal at 95>) (args-1 (condition-case err (let 
((signal-hook-function #'ert--should-signal-hook)) (list nil 42)) (error 
(progn (setq fn-0 #'signal) (list (car err) (cdr err))))))) (let 
((value-2 'ert-form-evaluation-aborted-3)) (let (form-description-4) (if 
(unwind-protect (setq value-2 (apply fn-0 args-1)) (setq 
form-description-4 (nconc (list '(should (equal nil 42))) (list :form 
(cons fn-0 args-1)) (if (eql value-2 'ert-form-evaluation-aborted-3) nil 
(list :value value-2)) (if (eql value-2 'ert-form-evaluation-aborted-3) 
nil (let* ((-explainer- (and t (ert--get-explainer 'equal)))) (if 
-explainer- (list :explanation (apply -explainer- args-1)) nil))))) 
(ert--signal-should-execution form-description-4)) nil (ert-fail 
form-description-4))) value-2))))
   test()
   command-line-1(("--eval" "(byte-compile-file \"perturb.el\")" "-l" 
"use.el" "-f" "test"))
   command-line()
   normal-top-level()
Invalid function: #<symbol equal at 95>

The byte-compiler seems to have erroneously removed the symbol-function 
for equal.

In GNU Emacs 29.1 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.38,
  cairo version 1.16.0) of 2023-08-01, modified by Debian built on
  x86-ubc-02
Windowing system distributor 'The X.Org Foundation', version 11.0.12201009
System Description: Debian GNU/Linux trixie/sid

Configured using:
  'configure --build x86_64-linux-gnu --prefix=/usr
  --sharedstatedir=/var/lib --libexecdir=/usr/libexec
  --localstatedir=/var/lib --infodir=/usr/share/info
  --mandir=/usr/share/man --with-libsystemd --with-pop=yes
  --enable-locallisppath=/etc/emacs:/usr/local/share/emacs/29.1/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/29.1/site-lisp:/usr/share/emacs/site-lisp
  --with-sound=alsa --without-gconf --with-mailutils
  --with-native-compilation --build x86_64-linux-gnu --prefix=/usr
  --sharedstatedir=/var/lib --libexecdir=/usr/libexec
  --localstatedir=/var/lib --infodir=/usr/share/info
  --mandir=/usr/share/man --with-libsystemd --with-pop=yes
  --enable-locallisppath=/etc/emacs:/usr/local/share/emacs/29.1/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/29.1/site-lisp:/usr/share/emacs/site-lisp
  --with-sound=alsa --without-gconf --with-mailutils
  --with-native-compilation --with-cairo --with-x=yes
  --with-x-toolkit=gtk3 --with-toolkit-scroll-bars 'CFLAGS=-g -O2
  -ffile-prefix-map=/build/reproducible-path/emacs-29.1+1=.
  -fstack-protector-strong -Wformat -Werror=format-security -Wall'
  'CPPFLAGS=-Wdate-time -D_FORTIFY_SOURCE=2' LDFLAGS=-Wl,-z,relro'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES
NATIVE_COMP NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3
THREADS TIFF TOOLKIT_SCROLL_BARS TREE_SITTER WEBP X11 XDBE XIM XINPUT2
XPM GTK3 ZLIB