comp: Fix mvar dependency chain (bug#67239)

* lisp/emacs-lisp/comp.el (comp-add-cond-cstrs): Emit assume with
the original mvar as explicit rhs.
(comp-fwprop-insn): Add note.
* test/src/comp-tests.el (67239-1): Add new test.
* test/src/comp-resources/comp-test-funcs.el (comp-test-time)
(comp-test-67239-00-f, comp-test-67239-0-f, comp-test-67239-1-f):
Define.

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 08d406b79995c8cfa8037ec2db1a75920430e238..39e32d5142c0a11bc3971a329be4d8bed6625bc1 100644 (file)
--- 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 85282e4dc973d355b75350551da204d7bfde2137..4b5f61d504f4b61bb0f0f1108811082c19e4d085 100644 (file)
--- 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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index c2f0af515700c3ed735b0f3265ee09e502b604ec..92b66496c469079b6d196e812e96cc0982ea30bc 100644 (file)
--- 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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;