Package: emacs;
Reported by: Eric Marsden <eric.marsden <at> risk-engineering.org>
Date: Wed, 2 Aug 2023 13:34:02 UTC
Severity: normal
Found in version 29.1
Done: Alan Mackenzie <acm <at> muc.de>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: help-debbugs <at> gnu.org (GNU bug Tracking System) To: Alan Mackenzie <acm <at> muc.de> Cc: tracker <at> debbugs.gnu.org Subject: bug#65017: closed (29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function) Date: Wed, 09 Aug 2023 12:28:01 +0000
[Message part 1 (text/plain, inline)]
Your message dated Wed, 9 Aug 2023 12:27:04 +0000 with message-id <ZNOGGP_L-mLeGOzf <at> ACM> and subject line Re: bug#65017: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function has caused the debbugs.gnu.org bug report #65017, regarding 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function to be marked as done. (If you believe you have received this mail in error, please contact help-debbugs <at> gnu.org.) -- 65017: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=65017 GNU Bug Tracking System Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
From: Eric Marsden <eric.marsden <at> risk-engineering.org> To: bug-gnu-emacs <at> gnu.org Subject: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function Date: Wed, 2 Aug 2023 12:28:24 +0200The 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
[Message part 3 (message/rfc822, inline)]
From: Alan Mackenzie <acm <at> muc.de> To: Eric Marsden <eric.marsden <at> risk-engineering.org> Cc: acm <at> muc.de, 65017-done <at> debbugs.gnu.org Subject: Re: bug#65017: 29.1; Byte compiler interaction with cl-lib function objects, removes symbol-function Date: Wed, 9 Aug 2023 12:27:04 +0000Hello, 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).
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.