procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix a nativecomp type propagation bug (bug#74771)

Browse source 
* 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.
This commit is contained in:
Andrea Corallo 2024-12-12 00:06:43 +01:00
parent 408ad273ee
commit d565a6747a
2 changed files with 10 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lisp/emacs-lisp/comp.el
View file

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

7
test/src/comp-tests.el
View file

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