Fix comp branch-optim pass (bug#73270)

* 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.

(cherry picked from commit cd739d3644be618008e5c369b4e96201a05a3d1b)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 8b48ce3455a8ceb502ae7cbf2a73f3a5c5253b9e..e19a507863e7b2a60787c93abed7a224c9ceed2f 100644 (file)
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -949,9 +949,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))
 

diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
index 084fcd8c9db03fd6ee4f2ee294ebdda558a7f51c..87d3220f3819af4d2516e9e7eeca3fd676153599 100644 (file)
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

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