diff options
Diffstat (limited to 'test/src/comp-tests.el')
-rw-r--r-- | test/src/comp-tests.el | 33 |
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)) () |