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 e63afa16a2324ef95af4d453c069a398b43645ba..651c7b7931e29fe139a76bcc031b6eaa935386d3 100644 (file)
--- 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 1e1376b363b9ddff8bdb886339f33cf0cd2648db..149afaf85d84a5fd78c0e4e3f9bbc41ebb353e30 100644 (file)
--- 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 d0ec63658191b1a347988e0eb9266fa3e1263e87..694d9d426d505ec19cc6b8f22a034b6c8209fed0 100644 (file)
--- 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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index faaa2f4e4f819b3ba480f1f850dede07b1e5c92b..23a108796b851517df7883bca25dafdc1a32876e 100644 (file)
--- 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")))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;