summaryrefslogtreecommitdiff
path: root/test/src/data-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/src/data-tests.el')
-rw-r--r--test/src/data-tests.el42
1 files changed, 42 insertions, 0 deletions
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 8af7e902109..a1959f62fd3 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -833,4 +833,46 @@ comparing the subr with a much slower Lisp implementation."
(should-error (defalias 'data-tests--da-c 'data-tests--da-d)
:type 'cyclic-function-indirection))
+(ert-deftest data-tests-bare-symbol ()
+ (dolist (symbols-with-pos-enabled '(nil t))
+ (dolist (sym (list nil t 'xyzzy (make-symbol "")))
+ (should (eq sym (bare-symbol (position-symbol sym 0)))))))
+
+(require 'cl-extra) ;For `cl--class-children'.
+
+(ert-deftest data-tests--cl-type-of ()
+ ;; Make sure that `cl-type-of' returns the most precise type.
+ ;; Note: This doesn't work for list/vector structs since those types
+ ;; are too difficult/unreliable to detect (so `cl-type-of' only says
+ ;; it's a `cons' or a `vector').
+ (dolist (val (list -2 10 (expt 2 128) nil t 'car :car
+ (symbol-function 'car)
+ (symbol-function 'progn)
+ (eval '(lambda (x) (+ x 1)) t)
+ (position-symbol 'car 7)
+ (position-symbol :car 7)))
+ (let* ((type (cl-type-of val))
+ (class (cl-find-class type))
+ (alltypes (cl--class-allparents class))
+ ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'.
+ ;; (e.g. `symbolp' returns nil on a sympos if that var is nil).
+ (symbols-with-pos-enabled t))
+ (dolist (parent alltypes)
+ (should (cl-typep val parent))
+ (dolist (subtype (cl--class-children (cl-find-class parent)))
+ (when (and (not (memq subtype alltypes))
+ (built-in-class-p (cl-find-class subtype))
+ (not (memq subtype
+ ;; FIXME: Some types don't have any associated
+ ;; predicate,
+ '( font-spec font-entity font-object
+ finalizer condvar terminal
+ native-comp-unit interpreted-function
+ tree-sitter-compiled-query
+ tree-sitter-node tree-sitter-parser))))
+ (cond
+ ((eq subtype 'function) (cl-functionp val))
+ (t (should-not (cl-typep val subtype))))))))))
+
+
;;; data-tests.el ends here