bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Basil Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors]

0. emacs -Q
1. M-: (condition-case nil 1 (:success 2)) RET
   => 2
2. M-: (condition-case-unless-debug nil 1 (:success 2)) RET
   => 1

This can easily be fixed in condition-case-unless-debug, and worked
around by using explicit 'debug' with condition-case, but I was
wondering if we want to do anything differently in
internal_lisp_condition_case or the byte-compiler (e.g. new warning)
instead?

Thanks,

-- 
Basil

In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.16.0, Xaw3d scroll bars) of 2023-07-01 built on blc
Repository revision: 6ce957154b701282217191d47764187535754529
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12101004
System Description: Ubuntu 22.04.2 LTS

Configured using:
 'configure CC=gcc-12 'CFLAGS=-Og -ggdb3' --prefix=/home/bic/.local
 --with-file-notification=yes --with-x --with-x-toolkit=lucid'

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

Important settings:
  value of $LC_MONETARY: en_IE.UTF-8
  value of $LC_NUMERIC: en_IE.UTF-8
  value of $LC_TIME: en_IE.UTF-8
  value of $LANG: en_GB.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068
epg-config gnus-util text-property-search time-date subr-x mm-decode
mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader
cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util
mail-prsvr mail-utils rmc iso-transl tooltip cconv eldoc paren electric
uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo x-toolkit
xinput2 x multi-tty make-network-process emacs)

Memory information:
((conses 16 36866 9072) (symbols 48 5177 0) (strings 32 13978 1460)
 (string-bytes 1 382244) (vectors 16 9300)
 (vector-slots 8 148637 8484) (floats 8 23 25) (intervals 56 246 0)
 (buffers 984 10))

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Eli Zaretskii]

> Cc: Mattias Engdegård <mattias.engdegard@gmail.com>
> Date: Sat, 01 Jul 2023 20:32:10 +0100
> From:  Basil Contovounesios via "Bug reports for GNU Emacs,
>  the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
> 
> 0. emacs -Q
> 1. M-: (condition-case nil 1 (:success 2)) RET
>    => 2
> 2. M-: (condition-case-unless-debug nil 1 (:success 2)) RET
>    => 1
> 
> This can easily be fixed in condition-case-unless-debug, and worked
> around by using explicit 'debug' with condition-case, but I was
> wondering if we want to do anything differently in
> internal_lisp_condition_case or the byte-compiler (e.g. new warning)
> instead?

Adding Stefan to the discussion.

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Mattias Engdegård]

> 2. M-: (condition-case-unless-debug nil 1 (:success 2)) RET
>   => 1
> 
> This can easily be fixed in condition-case-unless-debug, and worked
> around by using explicit 'debug' with condition-case, but I was
> wondering if we want to do anything differently in
> internal_lisp_condition_case or the byte-compiler (e.g. new warning)
> instead?

Good catch! I don't think we need to bother about the Lisp interpreter, but I added a byte-compiler warning for it in 59a350cb91.
Would you like to repair condition-case-unless-debug?

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Basil Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 274 bytes --]

Mattias Engdegård [2023-07-02 11:57 +0200] wrote:

> Good catch! I don't think we need to bother about the Lisp
> interpreter, but I added a byte-compiler warning for it in 59a350cb91.

Thanks.

> Would you like to repair condition-case-unless-debug?

Like so?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-condition-case-unless-debug-with-success.patch --]
[-- Type: text/x-diff, Size: 2120 bytes --]

From 8b47f52c81fe5d039a555f5037921f978191d2aa Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 3 Jul 2023 10:10:47 +0100
Subject: [PATCH] Fix condition-case-unless-debug with :success

* lisp/subr.el (condition-case-unless-debug): Don't add debug
condition to :success handler (bug#64404).
* test/lisp/subr-tests.el (condition-case-unless-debug-success):
New test.
---
 lisp/subr.el            |  9 ++++++---
 test/lisp/subr-tests.el | 11 +++++++++++
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 4c462830120..483083b29c3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4987,9 +4987,12 @@ condition-case-unless-debug
   `(condition-case ,var
        ,bodyform
      ,@(mapcar (lambda (handler)
-                 `((debug ,@(if (listp (car handler)) (car handler)
-                              (list (car handler))))
-                   ,@(cdr handler)))
+                 (let ((condition (car handler)))
+                   (if (eq condition :success)
+                       handler
+                     `((debug ,@(if (listp condition) condition
+                                  (list condition)))
+                       ,@(cdr handler)))))
                handlers)))
 
 (defmacro with-demoted-errors (format &rest body)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 1c220b1da18..14caf54b380 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1256,5 +1256,16 @@ subr--copy-tree
                              "((a b) (a b) #2# #2# #3# #3#)"
                              "((a b) (a b) [c d] [c d] #s(e f) #s(e f))")))))))
 
+(ert-deftest condition-case-unless-debug-success ()
+  "Test `condition-case-unless-debug' with :success (bug#64404)."
+  (should (= 1 (condition-case-unless-debug nil
+                   0
+                 (:success 1)
+                 (t 2))))
+  (should (= 1 (condition-case-unless-debug var
+                   0
+                 (:success (1+ var))
+                 (t var)))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.34.1


[-- Attachment #3: Type: text/plain, Size: 11 bytes --]


-- 
Basil

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Mattias Engdegård]

3 juli 2023 kl. 11.24 skrev Basil Contovounesios <contovob@tcd.ie>:

> Like so?

That looks fine! Just throw in a test case for condition-case-unless-debug (with and without :success) that actually catches an error, to make sure that the change hasn't impaired the basic functionality.

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Basil Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 292 bytes --]

Mattias Engdegård [2023-07-03 12:09 +0200] wrote:

> That looks fine! Just throw in a test case for condition-case-unless-debug (with
> and without :success) that actually catches an error, to make sure that the
> change hasn't impaired the basic functionality.

Right, how's this:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-condition-case-unless-debug-with-success.patch --]
[-- Type: text/x-diff, Size: 3419 bytes --]

From 6e74cd34dad6696c0be726fc48ee7fcc9ccf7f4f Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 3 Jul 2023 10:10:47 +0100
Subject: [PATCH] Fix condition-case-unless-debug with :success

* lisp/subr.el (condition-case-unless-debug): Don't add debug
condition to :success handler (bug#64404).
* test/lisp/subr-tests.el (condition-case-unless-debug)
(condition-case-unless-debug-success): New tests.
---
 lisp/subr.el            |  9 ++++++---
 test/lisp/subr-tests.el | 31 +++++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 4c462830120..483083b29c3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4987,9 +4987,12 @@ condition-case-unless-debug
   `(condition-case ,var
        ,bodyform
      ,@(mapcar (lambda (handler)
-                 `((debug ,@(if (listp (car handler)) (car handler)
-                              (list (car handler))))
-                   ,@(cdr handler)))
+                 (let ((condition (car handler)))
+                   (if (eq condition :success)
+                       handler
+                     `((debug ,@(if (listp condition) condition
+                                  (list condition)))
+                       ,@(cdr handler)))))
                handlers)))
 
 (defmacro with-demoted-errors (format &rest body)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 1c220b1da18..0d409cead26 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1256,5 +1256,36 @@ subr--copy-tree
                              "((a b) (a b) #2# #2# #3# #3#)"
                              "((a b) (a b) [c d] [c d] #s(e f) #s(e f))")))))))
 
+(ert-deftest condition-case-unless-debug ()
+  "Test `condition-case-unless-debug'."
+  (let ((debug-on-error nil))
+    (with-suppressed-warnings ((suspicious condition-case))
+      (should (= 0 (condition-case-unless-debug nil 0))))
+    (should (= 0 (condition-case-unless-debug nil 0 (t 1))))
+    (should (= 0 (condition-case-unless-debug x 0 (t (1+ x)))))
+    (should (= 1 (condition-case-unless-debug nil (error "") (t 1))))
+    (should (equal (condition-case-unless-debug x (error "") (t x))
+                   '(error "")))))
+
+(ert-deftest condition-case-unless-debug-success ()
+  "Test `condition-case-unless-debug' with :success (bug#64404)."
+  (let ((debug-on-error nil))
+    (should (= 1 (condition-case-unless-debug nil 0 (:success 1))))
+    (should (= 1 (condition-case-unless-debug nil 0 (:success 1) (t 2))))
+    (should (= 1 (condition-case-unless-debug nil 0 (t 2) (:success 1))))
+    (should (= 1 (condition-case-unless-debug x 0 (:success (1+ x)))))
+    (should (= 1 (condition-case-unless-debug x 0 (:success (1+ x)) (t x))))
+    (should (= 1 (condition-case-unless-debug x 0 (t x) (:success (1+ x)))))
+    (should (= 2 (condition-case-unless-debug nil (error "")
+                   (:success 1) (t 2))))
+    (should (= 2 (condition-case-unless-debug nil (error "")
+                   (t 2) (:success 1))))
+    (should (equal (condition-case-unless-debug x (error "")
+                     (:success (1+ x)) (t x))
+                   '(error "")))
+    (should (equal (condition-case-unless-debug x (error "")
+                     (t x) (:success (1+ x)))
+                   '(error "")))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.34.1


[-- Attachment #3: Type: text/plain, Size: 20 bytes --]


Thanks,

-- 
Basil

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Mattias Engdegård]

3 juli 2023 kl. 13.10 skrev Basil Contovounesios <contovob@tcd.ie>:

> Right, how's this:
> 
> <0001-Fix-condition-case-unless-debug-with-success.patch>

Splendid!

bug#64404: 30.0.50; condition-case-unless-debug mishandles :success

[Basil Contovounesios via Bug reports for GNU Emacs, the Swiss army knife of text editors]

close 64404 30.1
quit

Mattias Engdegård [2023-07-03 13:12 +0200] wrote:
> 3 juli 2023 kl. 13.10 skrev Basil Contovounesios <contovob@tcd.ie>:
>> Right, how's this:
>> <0001-Fix-condition-case-unless-debug-with-success.patch>
> Splendid!

Thanks, pushed and closing.

Fix condition-case-unless-debug with :success
4c2cc21354a 2023-07-08 12:14:57 +0100
https://git.sv.gnu.org/cgit/emacs.git/commit/?id=4c2cc21354a

-- 
Basil