mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-27 15:52:00 -08:00
Code Issues Projects Releases Wiki Activity

Fix comp branch-optim pass (bug#73270)

Browse source 
* test/src/comp-tests.el (comp-test-73270-1): Define new test.
* test/src/comp-resources/comp-test-funcs.el (comp-test-73270-base)
(comp-test-73270-child1, comp-test-73270-child2)
(comp-test-73270-child3, comp-test-73270-child4)
(comp-test-73270-1-f): Define.
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-type-p): Fix it for nil cstrs.
This commit is contained in:
Andrea Corallo 2024-10-15 15:30:49 +02:00
parent 358b38bc17
commit cd739d3644
3 changed files with 27 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

9
lisp/emacs-lisp/comp-cstr.el
View file

@ -950,9 +950,12 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(if-let ((pred (get type 'cl-deftype-satisfies)))
(and (null (range cstr))
(null (neg cstr))
(and (or (null (typeset cstr))
(equal (typeset cstr) `(,type)))
(cl-every pred (valset cstr))))
(if (null (typeset cstr))
(and (valset cstr)
(cl-every pred (valset cstr)))
(when (equal (typeset cstr) `(,type))
;; (valset cstr) can be nil as well.
(cl-every pred (valset cstr)))))
(error "Unknown predicate for type %s" type)))))
t))

17
test/src/comp-resources/comp-test-funcs.el
View file

@ -562,6 +562,23 @@
(defun comp-test-67883-1-f ()
'#1=(1 . #1#))
(cl-defstruct comp-test-73270-base)
(cl-defstruct
(comp-test-73270-child1 (:include comp-test-73270-base)))
(cl-defstruct
(comp-test-73270-child2 (:include comp-test-73270-base)))
(cl-defstruct
(comp-test-73270-child3 (:include comp-test-73270-base)))
(cl-defstruct
(comp-test-73270-child4 (:include comp-test-73270-base)))
(defun comp-test-73270-1-f (x)
(cl-typecase x
(comp-test-73270-child1 'child1)
(comp-test-73270-child2 'child2)
(comp-test-73270-child3 'child3)
(comp-test-73270-child4 'child4)))
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;

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

@ -592,6 +592,10 @@ dedicated byte-op code."
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-11/msg00925.html>"
(should-not (comp-test-67239-1-f)))
(comp-deftest comp-test-73270-1 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2024-09/msg00794.html>"
(should (eq (comp-test-73270-1-f (make-comp-test-73270-child4)) 'child4)))
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;