diff options
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 14 | ||||
| -rw-r--r-- | test/src/comp-resources/comp-test-funcs.el | 16 | ||||
| -rw-r--r-- | test/src/comp-tests.el | 4 |
3 files changed, 30 insertions, 4 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 08d406b7999..39e32d5142c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1967,10 +1967,14 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,(and (pred comp-mvar-p) mvar-3) (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) - (push `(assume ,mvar-tested ,(make-comp-mvar :type (comp-cstr-cl-tag mvar-tag))) - (comp-block-insns (comp-add-cond-cstrs-target-block b bb2))) - (push `(assume ,mvar-tested ,(make-comp-mvar :type (comp-cstr-cl-tag mvar-tag) :neg t)) - (comp-block-insns (comp-add-cond-cstrs-target-block b bb1)))) + (comp-emit-assume 'and mvar-tested + (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp-add-cond-cstrs-target-block b bb2) + nil) + (comp-emit-assume 'and mvar-tested + (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp-add-cond-cstrs-target-block b bb1) + t)) (`((set ,(and (pred comp-mvar-p) cmp-res) (,(pred comp--call-op-p) ,(and (or (pred comp--equality-fun-p) @@ -2645,6 +2649,8 @@ Fold the call in case." (_ (comp-cstr-shallow-copy lval rval)))) (`(assume ,lval ,(and (pred comp-mvar-p) rval)) + ;; NOTE we should probably assert this case in the future when + ;; will be possible. (comp-cstr-shallow-copy lval rval)) (`(assume ,lval (,kind . ,operands)) (cl-case kind diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 85282e4dc97..4b5f61d504f 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -543,6 +543,22 @@ (if (comp-test-struct-p pkg) x) t)) + +(cl-defstruct comp-test-time + unix) + +(defun comp-test-67239-00-f (a) + (cl-assert (stringp a))) + +(defsubst comp-test-67239-0-f (x _y) + (cl-etypecase x + (comp-test-time (error "foo")) + (string (comp-test-67239-00-f x)))) + +(defun comp-test-67239-1-f () + (let ((time (make-comp-test-time :unix (time-convert (current-time) 'integer)))) + (comp-test-67239-0-f "%F" time))) + ;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests ;; diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index c2f0af51570..92b66496c46 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -582,6 +582,10 @@ dedicated byte-op code." (advice-remove #'delete-region f) (should (equal comp-test-primitive-redefine-args '(1 2)))))) +(comp-deftest 67239-1 () + "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-11/msg00925.html>" + (should-not (comp-test-67239-1-f))) + ;;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests. ;; |