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.
This commit is contained in:
Andrea Corallo 2021-01-04 22:04:29 +01:00
parent a3f2373bfb
commit 5074447ef4
4 changed files with 39 additions and 1 deletions

View file

@ -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))

View file

@ -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 ()

View file

@ -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 ;;

View file

@ -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. ;;