From c43ef0b4d63dfeee2a3133d37c2264639228f4b0 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <acorallo@gnu.org>
Date: Tue, 15 Oct 2024 15:30:49 +0200
Subject: [PATCH] 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)
---
 lisp/emacs-lisp/comp-cstr.el               |  9 ++++++---
 test/src/comp-resources/comp-test-funcs.el | 17 +++++++++++++++++
 test/src/comp-tests.el                     |  4 ++++
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 8b48ce3455a..e19a507863e 100644
--- 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 084fcd8c9db..87d3220f381 100644
--- 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)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index dfeeaff05d8..487c95416ad 100644
--- 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)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;
-- 
2.39.5