master 8bb8cc5b49 1/2: Fix condition-case body for-effect miscompilation

[Mattias Engdegård]

branch: master
commit 8bb8cc5b49a0cb681327ce9abe38266d5e26d19c
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Fix condition-case body for-effect miscompilation
    
    (condition-case x A (:success B)) should not compile A for-effect even
    if the entire form is in for-effect context.
    
    * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
    Don't optimise the condition-case body form for effect (potentially
    discarding its value) if there is a success handler and a variable.
    * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases):
    Add test cases.
---
 lisp/emacs-lisp/byte-opt.el            |  5 +++-
 test/lisp/emacs-lisp/bytecomp-tests.el | 48 ++++++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 898dfffef6..ab35b0dde8 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -410,7 +410,10 @@ for speeding up processing.")
 
       (`(condition-case ,var ,exp . ,clauses)
        `(,fn ,var          ;Not evaluated.
-            ,(byte-optimize-form exp for-effect)
+             ,(byte-optimize-form exp
+                                  (if (assq :success clauses)
+                                      (null var)
+                                    for-effect))
           ,@(mapcar (lambda (clause)
                       (let ((byte-optimize--lexvars
                              (and lexical-binding
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 3400128759..36f541e867 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -704,6 +704,54 @@ inner loops respectively."
     (let ((bytecomp-tests--xx 1))
       (set (make-local-variable 'bytecomp-tests--xx) 2)
       bytecomp-tests--xx)
+
+    ;; Check for-effect optimisation of `condition-case' body form.
+    ;; With `condition-case' in for-effect context:
+    (let ((x (bytecomp-test-identity ?A))
+          (r nil))
+      (condition-case e
+          (characterp x)                ; value (:success, var)
+        (error (setq r 'bad))
+        (:success (setq r (list 'good e))))
+      r)
+    (let ((x (bytecomp-test-identity ?B))
+          (r nil))
+      (condition-case nil
+          (characterp x)               ; for-effect (:success, no var)
+        (error (setq r 'bad))
+        (:success (setq r 'good)))
+      r)
+    (let ((x (bytecomp-test-identity ?C))
+          (r nil))
+      (condition-case e
+          (characterp x)               ; for-effect (no :success, var)
+        (error (setq r (list 'bad e))))
+      r)
+    (let ((x (bytecomp-test-identity ?D))
+          (r nil))
+      (condition-case nil
+          (characterp x)               ; for-effect (no :success, no var)
+        (error (setq r 'bad)))
+      r)
+    ;; With `condition-case' in value context:
+    (let ((x (bytecomp-test-identity ?E)))
+      (condition-case e
+          (characterp x)               ; for-effect (:success, var)
+        (error (list 'bad e))
+        (:success (list 'good e))))
+    (let ((x (bytecomp-test-identity ?F)))
+      (condition-case nil
+          (characterp x)               ; for-effect (:success, no var)
+        (error 'bad)
+        (:success 'good)))
+    (let ((x (bytecomp-test-identity ?G)))
+      (condition-case e
+          (characterp x)               ; value (no :success, var)
+        (error (list 'bad e))))
+    (let ((x (bytecomp-test-identity ?H)))
+      (condition-case nil
+          (characterp x)               ; value (no :success, no var)
+        (error 'bad)))
     )
   "List of expressions for cross-testing interpreted and compiled code.")