diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2024-03-12 09:26:24 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2024-03-18 09:29:47 -0400 |
| commit | 706403f2aa3a306369a0150022da0cba1802ca2b (patch) | |
| tree | c2a2a7e1dc919efdead6ee36f1fb91e3f624c673 /test | |
| parent | 1a8b34a503e5af32851c1aac27a3f09e2345673b (diff) | |
| download | emacs-706403f2aa3a306369a0150022da0cba1802ca2b.tar.gz | |
(cl-type-of): New function to return more precise types (bug#69739)
* src/data.c (Fcl_type_of): New function, extracted from `Ftype_of`.
Make it return more precise types for symbols, integers, and subrs.
(Ftype_of): Use it.
(syms_of_data): Define the corresponding new symbols and defsubr
the new function.
* doc/lispref/objects.texi (Type Predicates): Document it.
* src/comp.c (emit_limple_insn): Use `Fcl_type_of`.
* lisp/emacs-lisp/cl-preloaded.el (subr): Demote it to `atom`.
(subr-native-elisp, subr-primitive): Add `compiled-function` as
parent instead.
(special-form): New type.
* lisp/obsolete/eieio-core.el (cl--generic-struct-tag):
* lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-generalizer):
Use `cl-type-of`.
cl--generic--unreachable-types): Update accordingly.
test/src/data-tests.el (data-tests--cl-type-of): New test.
Diffstat (limited to 'test')
| -rw-r--r-- | test/src/data-tests.el | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/test/src/data-tests.el b/test/src/data-tests.el index ad3b2071254..9d76c58224d 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -838,4 +838,41 @@ comparing the subr with a much slower Lisp implementation." (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 + (symbol-function 'car) + (symbol-function 'progn) + (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))) + (unless (memq subtype alltypes) + (unless (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 + ;; `functionp' also matches things of type + ;; `symbol' and `cons'. + ;; FIXME: `subr-primitive-p' also matches + ;; special-forms. + function subr-primitive)) + (should-not (cl-typep val subtype))))))))) + + ;;; data-tests.el ends here |