master fa669c4b17c: Comp: Fix limplification pass (bug#62537)

[Andrea Corallo]

branch: master
commit fa669c4b17c04eff852eb23a6179ccb8fab864db
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    Comp: Fix limplification pass (bug#62537)
    
    * test/src/comp-resources/comp-test-funcs.el (comp-test-62537-1-f)
    (comp-test-62537-2-f): New functions.
    
    * lisp/emacs-lisp/comp.el (comp-jump-table-optimizable): Make it
    stricter add a comment.
---
 lisp/emacs-lisp/comp.el                    |  9 ++++++++-
 test/src/comp-resources/comp-test-funcs.el | 13 +++++++++++++
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 841b0ebf29d..025d21631bb 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1712,6 +1712,10 @@ Return value is the fall-through block name."
 
 (defun comp-jump-table-optimizable (jmp-table)
   "Return t if JMP-TABLE can be optimized out."
+  ;; Identify LAP sequences like:
+  ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 
rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) 
. 24)
+  ;; (byte-switch)
+  ;; (TAG 126 . 10)
   (cl-loop
    with labels = (cl-loop for target-label being each hash-value of jmp-table
                           collect target-label)
@@ -1719,7 +1723,10 @@ Return value is the fall-through block name."
    for l in (cdr-safe labels)
    unless (= l x)
      return nil
-   finally return t))
+   finally return (pcase (nth (1+ (comp-limplify-pc comp-pass))
+                              (comp-func-lap comp-func))
+                    (`(TAG ,label . ,_label-sp)
+                     (= label l)))))
 
 (defun comp-emit-switch (var last-insn)
   "Emit a Limple for a lap jump table given VAR and LAST-INSN."
diff --git a/test/src/comp-resources/comp-test-funcs.el 
b/test/src/comp-resources/comp-test-funcs.el
index fff881dd595..73da7182a54 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -518,6 +518,19 @@
 (defun comp-test-48029-nonascii-žžž-f (arg)
   (when arg t))
 
+(defun comp-test-62537-1-f ())
+
+(defun comp-test-62537-2-f ()
+  (when (let ((val (comp-test-62537-1-f)))
+         (cond
+          ((eq val 'x)
+           t)
+          ((eq val 'y)
+           'y)))
+    (comp-test-62537-1-f))
+  t)
+
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;