[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 5074447 1/3: Fix type inference for bug#45635
From: |
Andrea Corallo |
Subject: |
feature/native-comp 5074447 1/3: Fix type inference for bug#45635 |
Date: |
Mon, 4 Jan 2021 16:35:04 -0500 (EST) |
branch: feature/native-comp
commit 5074447ef4980e2eb613e908e346fd3471f52139
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
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.
---
lisp/emacs-lisp/comp-cstr.el | 16 ++++++++++++++++
test/lisp/emacs-lisp/comp-cstr-tests.el | 4 +++-
test/src/comp-test-funcs.el | 15 +++++++++++++++
test/src/comp-tests.el | 5 +++++
4 files changed, 39 insertions(+), 1 deletion(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index e63afa1..651c7b7 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 1e1376b..149afaf 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 d0ec636..694d9d4 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 faaa2f4..23a1087 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. ;;