mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

cl-types: Simplify a bit further

Browse source 
Mostly, get rid of `cl--type-flag` and rely only on the presence/absence
of the type on `cl--types-list` to "flag" erroring-types.
Also, don't try and catch errors during dispatch.

* lisp/emacs-lisp/cl-types.el (cl--type-dispatch-list): Move to the
relevant section.
(cl--type-parents): Inline into sole caller.
(cl--type-deftype): Add `arglist` argument.
Don't signal an error if the type already existed but wasn't in
`cl--type-list` since that's normal and we can fix it.
Don't touch `cl--type-flag` any more.
Don't add to `cl--type-list` if it can't be used without arguments.
(cl-deftype2): Adjust call accordingly.
(cl--type-error): Inline into sole caller.
(cl-types-of): Be more careful to preserve ordering of types
before passing them to `merge-ordered-lists`.
Add `types` argument for use by dispatch.
Don't bother skipping the `root-type` since that's a built-in type,
so it should never happen anyway.
Don't catch errors if called from dispatch.
Don't bother with `cl--type-flag`.
(cl--type-generalizer): Use new arg of `cl-types-of` instead of
let-binding `cl--type-list`, in case `cl-types-of` ends up (auto)loading
a file or some such thing which needs to use/modify `cl--type-list`.
(cl--type-undefine): Move to end of file.

* test/lisp/emacs-lisp/cl-types-tests.el (cl-types-test): Remove DAG
test since we don't detect such errors any more.
Relax ordering test when the order is not guaranteed
by parent-relationships.
This commit is contained in:
Stefan Monnier 2025-05-05 14:57:05 -04:00
parent 8f649c4270
commit 68a50324a7
2 changed files with 104 additions and 129 deletions
Download patch file Download diff file Expand all files Collapse all files

23
test/lisp/emacs-lisp/cl-types-tests.el
View file

@ -48,14 +48,15 @@
"Test types definition, cl-types-of and method dispatching."
;; Invalid DAG error
(should-error
(eval
'(cl-deftype2 unsigned-16bits ()
"Unsigned 16-bits integer."
(declare (parents unsigned-8bits))
'(unsigned-byte 16))
lexical-binding
))
;; FIXME: We don't test that any more.
;; (should-error
;; (eval
;; '(cl-deftype2 unsigned-16bits ()
;; "Unsigned 16-bits integer."
;; (declare (parents unsigned-8bits))
;; '(unsigned-byte 16))
;; lexical-binding
;; ))
;; Test that (cl-types-of 4) is (multiples-of-4 multiples-of-2 ...)
;; Test that (cl-types-of 6) is (multiples-of-3 multiples-of-2 ...)
@ -70,8 +71,10 @@
(should (equal '(multiples-of-3 multiples-of-2)
(seq-intersection (cl-types-of 6) types)))
(should (equal '(multiples-of-3 multiples-of-4 multiples-of-2)
(seq-intersection (cl-types-of 12) types)))
(should (member (seq-intersection (cl-types-of 12) types)
;; Order between 3 and 4/2 is undefined.
'((multiples-of-3 multiples-of-4 multiples-of-2)
(multiples-of-4 multiples-of-2 multiples-of-3))))
(should (equal '()
(seq-intersection (cl-types-of 5) types)))