From 898f929215cf644c651abf789b564fcbc50ffbdd Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Sun, 15 Nov 2020 23:31:00 +0100
Subject: [PATCH] Fix nativecomp cond-rw pass

	* lisp/emacs-lisp/comp.el (comp-mvar-symbol-p): Improve it.
	(comp-cond-rw-func): Fix logic for multiple predecessor on target
	block.
	* test/src/comp-tests.el (comp-test-cond-rw-1): New test.
	* test/src/comp-test-funcs.el (comp-test-cond-rw-1-1-f)
	(comp-test-cond-rw-1-2-f): New functions.
---
 lisp/emacs-lisp/comp.el     | 25 +++++++++++++++++--------
 test/src/comp-test-funcs.el | 10 ++++++++++
 test/src/comp-tests.el      |  4 ++++
 3 files changed, 31 insertions(+), 8 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 397b0fd70b5..c84c254e585 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -571,9 +571,10 @@ Integer values are handled in the `range' slot.")
                   (> high most-positive-fixnum))
         t))))
 
-(defsubst comp-mvar-symbol-p (mvar)
+(defun comp-mvar-symbol-p (mvar)
   "Return t if MVAR is certainly a symbol."
-  (equal (comp-mvar-typeset mvar) '(symbol)))
+  (or (equal (comp-mvar-typeset mvar) '(symbol))
+      (cl-every #'symbolp (comp-mvar-valset mvar))))
 
 (defsubst comp-mvar-cons-p (mvar)
   "Return t if MVAR is certainly a cons."
@@ -1999,12 +2000,20 @@ Return the corresponding rhs slot number."
                      ,(and (or 'eq 'eql '= 'equal) test-fn) ,op1 ,op2))
 	       (comment ,_comment-str)
 	       (cond-jump ,cond ,(pred comp-mvar-p) ,bb-1 ,_bb-2))
-             (when-let ((target-slot1 (comp-cond-rw-target-slot
-                                      (comp-mvar-slot op1) (car insns-seq) b)))
-	       (comp-emit-assume target-slot1 op2 bb-1 test-fn))
-             (when-let ((target-slot2 (comp-cond-rw-target-slot
-                                      (comp-mvar-slot op2) (car insns-seq) b)))
-	       (comp-emit-assume target-slot2 op1 bb-1 test-fn))
+             ;; FIXME We guard the target block against having more
+             ;; then one predecessor.  The right fix will be to add a
+             ;; new dedicated basic block for the assumptions so we
+             ;; can proceed always.
+             (when (= (length (comp-block-in-edges
+                                 (gethash bb-1
+                                          (comp-func-blocks comp-func))))
+                      1)
+               (when-let ((target-slot1 (comp-cond-rw-target-slot
+                                         (comp-mvar-slot op1) (car insns-seq) b)))
+                 (comp-emit-assume target-slot1 op2 bb-1 test-fn))
+               (when-let ((target-slot2 (comp-cond-rw-target-slot
+                                         (comp-mvar-slot op2) (car insns-seq) b)))
+                 (comp-emit-assume target-slot2 op1 bb-1 test-fn)))
 	     (cl-return-from in-the-basic-block))))))
 
 (defun comp-cond-rw (_)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index bcf9fcb0fd1..207b6455f73 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -370,6 +370,16 @@
         (copy-comp-mvar insn)
       insn)))
 
+(defun comp-test-cond-rw-1-1-f ())
+
+(defun comp-test-cond-rw-1-2-f ()
+  (let ((it (comp-test-cond-rw-1-1-f))
+	(key 't))
+    (if (or (equal it key)
+	    (eq key t))
+	it
+      nil)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index d377b089932..bf3f57a85e3 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -449,6 +449,10 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
                  '(1 2 3 (4 5 6))))
   (should (null (comp-test-copy-insn-f nil))))
 
+(comp-deftest comp-test-cond-rw-1 ()
+  "Check cond-rw does not break target blocks with multiple predecessor."
+  (should (null (comp-test-cond-rw-1-2-f))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;
-- 
2.39.5