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.
This commit is contained in:
Mattias Engdegård 2022-12-23 20:04:22 +01:00
parent cc2cc0c297
commit 8bb8cc5b49
2 changed files with 52 additions and 1 deletions

View file

@ -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

View file

@ -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.")