From: Andrea Corallo <acorallo@gnu.org>
Date: Wed, 11 Dec 2024 23:06:43 +0000 (+0100)
Subject: Fix a nativecomp type propagation bug (bug#74771)
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a8d71effce78ae0aebf6cd94e7a7f2d2aeeb9df4;p=emacs.git

Fix a nativecomp type propagation bug (bug#74771)

* lisp/emacs-lisp/comp.el (comp--add-cond-cstrs): Don't emit negated
cstr.
* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a test.

(cherry picked from commit d565a6747a2bb3c6699a95e60e5f522f80a1ca0a)
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 8b57f48b7de..2cd3d2d03b9 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2027,15 +2027,11 @@ TARGET-BB-SYM is the symbol name of the target block."
               (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
          (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))
+         (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,_bb1 ,bb2))
        (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))
+                          (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+                          (comp--add-cond-cstrs-target-block b bb2)
+                          nil))
       (`((set ,(and (pred comp-mvar-p) cmp-res)
               (,(pred comp--call-op-p)
                ,(and (or (pred comp--equality-fun-p)
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 2991a05d771..6b608d73540 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -1512,7 +1512,12 @@ Return a list of results."
          (if (functionp x)
              (error "")
            x))
-       '(not function))))
+       '(not function))
+      ;; 81
+      ((defun comp-tests-ret-type-spec-f (x)
+         (print (comp-foo-p x))
+         (comp-foo-p x))
+       'boolean)))
 
   (defun comp-tests-define-type-spec-test (number x)
     `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()