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:
parent
a3f2373bfb
commit
5074447ef4
4 changed files with 39 additions and 1 deletions
|
@ -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))
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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 ;;
|
||||
|
|
|
@ -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. ;;
|
||||
|
|
Loading…
Add table
Reference in a new issue