From: Andrea Corallo <akrl@sdf.org>
Date: Mon, 4 Jan 2021 21:04:29 +0000 (+0100)
Subject: Fix type inference for bug#45635
X-Git-Tag: emacs-28.0.90~2727^2~180
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5074447ef4980e2eb613e908e346fd3471f52139;p=emacs.git

Fix type inference for bug#45635

	* lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-1-no-mem): Fix
	missing mixed pos neg handling.
	* test/lisp/emacs-lisp/comp-cstr-tests.el
	(comp-cstr-typespec-tests-alist): Add a test.
	* test/src/comp-tests.el (45635): New testcase.
	* test/src/comp-test-funcs.el (comp-test-45635-f): New function.
---

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index e63afa16a23..651c7b7931e 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -558,6 +558,22 @@ DST is returned."
               ;; "simple" for now.
               (give-up))
 
+            ;; When every neg type is a subtype of some pos one.
+            ;; In case return pos.
+            (when (and (typeset neg)
+                       (cl-every (lambda (x)
+                                   (cl-some (lambda (y)
+                                              (comp-subtype-p x y))
+                                            (append (typeset pos)
+                                                    (when (range pos)
+                                                      '(integer)))))
+                                 (typeset neg)))
+              (setf (typeset dst) (typeset pos)
+                    (valset dst) (valset pos)
+                    (range dst) (range pos)
+                    (neg dst) nil)
+              (cl-return-from comp-cstr-union-1-no-mem dst))
+
             ;; Verify disjoint condition between positive types and
             ;; negative types coming from values, in case give-up.
             (let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el
index 1e1376b363b..149afaf85d8 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -207,7 +207,9 @@
       ;; 83
       ((not t) . nil)
       ;; 84
-      ((not nil) . t))
+      ((not nil) . t)
+      ;; 85
+      ((or (not string) t) . t))
     "Alist type specifier -> expected type specifier."))
 
 (defmacro comp-cstr-synthesize-tests ()
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index d0ec6365819..694d9d426d5 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -463,6 +463,21 @@
 			 eshell-term eshell-unix))
 	sym)))
 
+(defun comp-test-45635-f (&rest args)
+  ;; Reduced from `set-face-attribute'.
+  (let ((spec args)
+	family)
+    (while spec
+      (cond ((eq (car spec) :family)
+	     (setq family (cadr spec))))
+      (setq spec (cddr spec)))
+    (when (and (stringp family)
+	       (string-match "\\([^-]*\\)-\\([^-]*\\)" family))
+      (setq family (match-string 2 family)))
+    (when (or (stringp family)
+	      (eq family 'unspecified))
+      family)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index faaa2f4e4f8..23a108796b8 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -487,6 +487,11 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
 <https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-01/msg00029.html>."
   (should (eq (comp-test-45576-f) 'eval)))
 
+(comp-deftest 45635-1 ()
+  "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-01/msg00158.html>."
+  (should (string= (comp-test-45635-f :height 180 :family "PragmataPro Liga")
+                   "PragmataPro Liga")))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;