From ffcd490cb49ba86d625288ea425d98e8cac22a05 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Wed, 23 Dec 2020 15:51:55 +0100
Subject: [PATCH] Negate only values while constraining variables (bug#45376)

	* lisp/emacs-lisp/comp-cstr.el (comp-cstr-value-negation): New
	function.
	* lisp/emacs-lisp/comp.el (comp-fwprop-insn): Use
	`comp-cstr-value-negation'.
	* test/src/comp-test-funcs.el (comp-test-45376-1-f): Rename.
	(comp-test-45376-2-f): New funcion.
	* test/src/comp-tests.el (bug-45376-1): Rename test.
	(bug-45376-2): Add test.
---
 lisp/emacs-lisp/comp-cstr.el | 14 ++++++++++++++
 lisp/emacs-lisp/comp.el      |  2 +-
 test/src/comp-test-funcs.el  | 20 +++++++++++++++++++-
 test/src/comp-tests.el       |  8 ++++++--
 4 files changed, 40 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 92c981f5acf..8b5639c8a4d 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -701,6 +701,20 @@ DST is returned."
           (neg dst) (not (neg src)))
     dst))
 
+(defun comp-cstr-value-negation (dst src)
+  "Negate values in SRC setting the result in DST.
+DST is returned."
+  (with-comp-cstr-accessors
+    (if (or (valset src) (range src))
+        (setf (typeset dst) ()
+              (valset dst) (valset src)
+              (range dst) (range src)
+              (neg dst) (not (neg src)))
+      (setf (typeset dst) (typeset src)
+            (valset dst) ()
+            (range dst) ()))
+    dst))
+
 (defun comp-cstr-negation-make (src)
   "Negate SRC and return a new constraint."
   (comp-cstr-negation (make-comp-cstr) src))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 485e5dc6ad2..6ed50dc0122 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2534,7 +2534,7 @@ Fold the call in case."
        (not
         ;; Prevent double negation!
         (unless (comp-cstr-neg (car operands))
-          (comp-cstr-negation lval (car operands))))))
+          (comp-cstr-value-negation lval (car operands))))))
     (`(setimm ,lval ,v)
      (setf (comp-mvar-value lval) v))
     (`(phi ,lval . ,rest)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index d6bcfca2d94..7731e6547b1 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -417,7 +417,7 @@
 	(setq args (cons (substring arg start pos) args))))
     args))
 
-(defun comp-test-45376-f ()
+(defun comp-test-45376-1-f ()
   ;; Reduced from `eshell-ls-find-column-lengths'.
   (let* (res
 	 (len 2)
@@ -431,6 +431,24 @@
 	    i (1+ i)))
     res))
 
+(defun comp-test-45376-2-f ()
+  ;; Also reduced from `eshell-ls-find-column-lengths'.
+  (let* ((x 1)
+	 res)
+    (while x
+      (let* ((y 4)
+	     (i 0))
+	(while (> y 0)
+	  (when (= i x)
+	    (setq i 0))
+	  (setf res (cons i res))
+	  (setq y (1- y)
+		i (1+ i)))
+	(if (>= x 3)
+	    (setq x nil)
+	  (setq x (1+ x)))))
+    res))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 5f2d702fca0..e0d4bf8df5e 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -409,9 +409,13 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
   "Broken call args assumptions lead to infinite loop."
   (should (equal (comp-test-assume-in-loop-1-f "cd") '("cd"))))
 
-(comp-deftest bug-45376 ()
+(comp-deftest bug-45376-1 ()
   "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
-  (should (equal (comp-test-45376-f) '(1 0))))
+  (should (equal (comp-test-45376-1-f) '(1 0))))
+
+(comp-deftest bug-45376-2 ()
+  "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
+  (should (equal (comp-test-45376-2-f) '(0 2 1 0 1 0 1 0 0 0 0 0))))
 
 (defvar comp-test-primitive-advice)
 (comp-deftest primitive-advice ()
-- 
2.39.5