From: Andrea Corallo <akrl@sdf.org>
Date: Fri, 18 Dec 2020 17:37:16 +0000 (+0100)
Subject: Fix value type inference for doubly negate constraints
X-Git-Tag: emacs-28.0.90~2727^2~239
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6f3570cd4a615caa02c3d86320049a5631ab9b25;p=emacs.git

Fix value type inference for doubly negate constraints

	* lisp/emacs-lisp/comp.el (comp-fwprop-insn): Do not propagate in
	case of double negation.
	* test/src/comp-test-funcs.el (comp-test-assume-double-neg-f):
	New function.
	* test/src/comp-tests.el (assume-double-neg): New test.
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 5d2f8d412fe..895e1ac33e4 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2530,7 +2530,9 @@ Fold the call in case."
        (and
         (apply #'comp-cstr-intersection lval operands))
        (not
-        (comp-cstr-negation lval (car operands)))))
+        ;; Prevent double negation!
+        (unless (comp-cstr-neg (car operands))
+          (comp-cstr-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 5fc032b127d..7f70fc2460c 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -395,6 +395,16 @@
     (1 " ➊") (2 " ➋") (3 " ➌") (4 " ➍") (5 " ➎") (6 " ➏")
     (7 " ➐") (8 " ➑") (9 " ➒") (10 " ➓") (_ "")))
 
+(defun comp-test-assume-double-neg-f (collection value)
+  ;; Reduced from `auth-source-search-collection'.
+  (when (atom collection)
+    (setq collection (list collection)))
+  (or (eq value t)
+      ;; value is (not (member t))
+      (eq collection value)
+      ;; collection is t, not (member t)!
+      (member value collection)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 8e069fb3082..eeff599de4c 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -401,6 +401,10 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
 <https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01771.html>"
   (should (string= " ➊" (comp-test-45342-f 1))))
 
+(comp-deftest assume-double-neg ()
+  "In fwprop assumtions (not (not (member x))) /= (member x)."
+  (should-not (comp-test-assume-double-neg-f "bar" "foo")))
+
 (defvar comp-test-primitive-advice)
 (comp-deftest primitive-advice ()
   "Test effectiveness of primitive advicing."