From c60f2f458a63a8ae4288652228f24e43fdc7bba7 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Sat, 6 Mar 2021 22:36:50 +0100
Subject: [PATCH] Fix `comp-cstr-intersection-no-hashcons' for negated result
 cstr

	* lisp/emacs-lisp/comp-cstr.el
	(comp-cstr-intersection-no-hashcons): When negated and
	necessary relax dst to t.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a test.
---
 lisp/emacs-lisp/comp-cstr.el | 32 +++++++++++++++++++-------------
 test/src/comp-tests.el       |  9 ++++++++-
 2 files changed, 27 insertions(+), 14 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index d6423efa0d6..4397a914981 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -1001,20 +1001,26 @@ promoted to their types.
 DST is returned."
   (with-comp-cstr-accessors
     (apply #'comp-cstr-intersection dst srcs)
-    (let (strip-values strip-types)
-      (cl-loop for v in (valset dst)
-               unless (or (symbolp v)
-                          (fixnump v))
-                 do (push v strip-values)
-                    (push (type-of v) strip-types))
-      (when strip-values
-        (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
-              (valset dst) (cl-set-difference (valset dst) strip-values)))
-      (cl-loop for (l . h) in (range dst)
-               when (or (bignump l) (bignump h))
+    (if (and (neg dst)
+             (valset dst)
+             (cl-notevery #'symbolp (valset dst)))
+        (setf (valset dst) ()
+              (typeset dst) '(t)
+              (range dst) ()
+              (neg dst) nil)
+      (let (strip-values strip-types)
+        (cl-loop for v in (valset dst)
+                 unless (symbolp v)
+                   do (push v strip-values)
+                      (push (type-of v) strip-types))
+        (when strip-values
+          (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
+                (valset dst) (cl-set-difference (valset dst) strip-values)))
+        (cl-loop for (l . h) in (range dst)
+                 when (or (bignump l) (bignump h))
                  do (setf (range dst) '((- . +)))
-                    (cl-return))
-      dst)))
+                    (cl-return))))
+    dst))
 
 (defun comp-cstr-intersection-make (&rest srcs)
   "Combine SRCS by intersection set operation and return a new constraint."
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index cd1c2e0735e..f60e4ab0497 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -1340,7 +1340,14 @@ Return a list of results."
          (unless (eql x -0.0)
            (error ""))
          x)
-       float)))
+       float)
+
+      ;; 73
+      ((defun comp-tests-ret-type-spec-f (x)
+         (when (eql x 1.0)
+	   (error ""))
+         x)
+       t)))
 
   (defun comp-tests-define-type-spec-test (number x)
     `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
-- 
2.39.2