summaryrefslogtreecommitdiff
path: root/test/src/comp-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/src/comp-tests.el')
-rw-r--r--test/src/comp-tests.el33
1 files changed, 30 insertions, 3 deletions
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 0aa9e76fa2d..b2fd2f68826 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -28,6 +28,7 @@
(require 'ert)
(require 'ert-x)
(require 'cl-lib)
+(require 'cl-seq)
(require 'comp)
(require 'comp-cstr)
@@ -903,14 +904,33 @@ Return a list of results."
(should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f)))
(should (= (comp-tests-fw-prop-1-f) 6))))
+(defun comp-tests--type-lists-equal (l1 l2)
+ (and (= (length l1) (length l2))
+ (cl-every #'comp-tests--types-equal l1 l2)))
+
+(defun comp-tests--types-equal (t1 t2)
+ "Whether the types T1 and T2 are equal."
+ (or (equal t1 t2) ; for atoms, and optimization for the common case
+ (and (consp t1) (consp t2)
+ (eq (car t1) (car t2))
+ (cond ((memq (car t1) '(and or member))
+ ;; Order or duplicates don't matter.
+ (null (cl-set-exclusive-or (cdr t1) (cdr t2)
+ :test #'comp-tests--types-equal)))
+ ((eq (car t1) 'function)
+ (and (comp-tests--type-lists-equal (nth 1 t1) (nth 1 t2))
+ (comp-tests--types-equal (nth 2 t1) (nth 2 t2))))
+ (t (comp-tests--type-lists-equal (cdr t1) (cdr t2)))))))
+
(defun comp-tests-check-ret-type-spec (func-form ret-type)
(let ((lexical-binding t)
(native-comp-speed 2)
(f-name (cl-second func-form)))
(eval func-form t)
(native-compile f-name)
- (should (equal (cl-third (subr-type (symbol-function f-name)))
- ret-type))))
+ (should (comp-tests--types-equal
+ (cl-third (subr-type (symbol-function f-name)))
+ ret-type))))
(cl-eval-when (compile eval load)
(cl-defstruct comp-foo a b)
@@ -1476,7 +1496,14 @@ Return a list of results."
(if (comp-foo-p x)
x
(error "")))
- 'comp-foo)))
+ 'comp-foo)
+
+ ;; 80
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (functionp x)
+ (error "")
+ x))
+ '(not function))))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()