aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2024-12-12 00:06:43 +0100
committerAndrea Corallo2025-03-23 17:33:27 +0100
commitd565a6747a2bb3c6699a95e60e5f522f80a1ca0a (patch)
treee715bd3365ef80e794f969d5404f2f378066d921
parent408ad273eeadf72dea11b89ea2a44f36ea0e2295 (diff)
downloademacs-d565a6747a2bb3c6699a95e60e5f522f80a1ca0a.tar.gz
emacs-d565a6747a2bb3c6699a95e60e5f522f80a1ca0a.zip
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.
-rw-r--r--lisp/emacs-lisp/comp.el12
-rw-r--r--test/src/comp-tests.el7
2 files changed, 10 insertions, 9 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 6ad00f63971..8b1689e5668 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."
2027 (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag))) 2027 (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
2028 (set ,(and (pred comp-mvar-p) mvar-3) 2028 (set ,(and (pred comp-mvar-p) mvar-3)
2029 (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) 2029 (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2)))
2030 (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) 2030 (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,_bb1 ,bb2))
2031 (comp--emit-assume 'and mvar-tested 2031 (comp--emit-assume 'and mvar-tested
2032 (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) 2032 (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
2033 (comp--add-cond-cstrs-target-block b bb2) 2033 (comp--add-cond-cstrs-target-block b bb2)
2034 nil) 2034 nil))
2035 (comp--emit-assume 'and mvar-tested
2036 (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
2037 (comp--add-cond-cstrs-target-block b bb1)
2038 t))
2039 (`((set ,(and (pred comp-mvar-p) cmp-res) 2035 (`((set ,(and (pred comp-mvar-p) cmp-res)
2040 (,(pred comp--call-op-p) 2036 (,(pred comp--call-op-p)
2041 ,(and (or (pred comp--equality-fun-p) 2037 ,(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."
1512 (if (functionp x) 1512 (if (functionp x)
1513 (error "") 1513 (error "")
1514 x)) 1514 x))
1515 '(not function)))) 1515 '(not function))
1516 ;; 81
1517 ((defun comp-tests-ret-type-spec-f (x)
1518 (print (comp-foo-p x))
1519 (comp-foo-p x))
1520 'boolean)))
1516 1521
1517 (defun comp-tests-define-type-spec-test (number x) 1522 (defun comp-tests-define-type-spec-test (number x)
1518 `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () 1523 `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()