summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorPhilipp Stephani <phst@google.com>2021-12-30 17:18:54 +0100
committerPhilipp Stephani <phst@google.com>2021-12-30 17:19:31 +0100
commit097452efbc0d087fbff401651bc6379721202243 (patch)
treee3cbec00f4c1b800101d24a681a742493f9a98e5 /lisp/emacs-lisp
parentf6da1eed7447c363ef927fea9b23a7b35587473c (diff)
downloademacs-097452efbc0d087fbff401651bc6379721202243.tar.gz
emacs-097452efbc0d087fbff401651bc6379721202243.tar.bz2
emacs-097452efbc0d087fbff401651bc6379721202243.zip
* lisp/emacs-lisp/ert.el (ert-select-tests): Simplify nested switch
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/ert.el82
1 files changed, 36 insertions, 46 deletions
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index da14b93d1bf..e3e85b5cefb 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1015,52 +1015,42 @@ contained in UNIVERSE."
(unless (ert-test-boundp selector)
(signal 'ert-test-unbound (list selector)))
(list (ert-get-test selector)))
- (`(,operator . ,operands)
- (cl-ecase operator
- (member
- (mapcar (lambda (purported-test)
- (pcase-exhaustive purported-test
- ((pred symbolp)
- (unless (ert-test-boundp purported-test)
- (signal 'ert-test-unbound
- (list purported-test)))
- (ert-get-test purported-test))
- ((pred ert-test-p) purported-test)))
- operands))
- (eql
- (cl-assert (eql (length operands) 1))
- (ert-select-tests `(member ,@operands) universe))
- (and
- ;; Do these definitions of AND, NOT and OR satisfy de
- ;; Morgan's laws? Should they?
- (cl-case (length operands)
- (0 (ert-select-tests 't universe))
- (t (ert-select-tests `(and ,@(cdr operands))
- (ert-select-tests (car operands)
- universe)))))
- (not
- (cl-assert (eql (length operands) 1))
- (let ((all-tests (ert-select-tests 't universe)))
- (cl-set-difference all-tests
- (ert-select-tests (car operands)
- all-tests))))
- (or
- (cl-case (length operands)
- (0 (ert-select-tests 'nil universe))
- (t (cl-union (ert-select-tests (car operands) universe)
- (ert-select-tests `(or ,@(cdr operands))
- universe)))))
- (tag
- (cl-assert (eql (length operands) 1))
- (let ((tag (car operands)))
- (ert-select-tests `(satisfies
- ,(lambda (test)
- (member tag (ert-test-tags test))))
- universe)))
- (satisfies
- (cl-assert (eql (length operands) 1))
- (cl-remove-if-not (car operands)
- (ert-select-tests 't universe)))))))
+ (`(member . ,operands)
+ (mapcar (lambda (purported-test)
+ (pcase-exhaustive purported-test
+ ((pred symbolp)
+ (unless (ert-test-boundp purported-test)
+ (signal 'ert-test-unbound
+ (list purported-test)))
+ (ert-get-test purported-test))
+ ((pred ert-test-p) purported-test)))
+ operands))
+ (`(eql ,operand)
+ (ert-select-tests `(member ,operand) universe))
+ ;; Do these definitions of AND, NOT and OR satisfy de Morgan's
+ ;; laws? Should they?
+ (`(and)
+ (ert-select-tests 't universe))
+ (`(and ,first . ,rest)
+ (ert-select-tests `(and ,@rest)
+ (ert-select-tests first universe)))
+ (`(not ,operand)
+ (let ((all-tests (ert-select-tests 't universe)))
+ (cl-set-difference all-tests
+ (ert-select-tests operand all-tests))))
+ (`(or)
+ (ert-select-tests 'nil universe))
+ (`(or ,first . ,rest)
+ (cl-union (ert-select-tests first universe)
+ (ert-select-tests `(or ,@rest) universe)))
+ (`(tag ,tag)
+ (ert-select-tests `(satisfies
+ ,(lambda (test)
+ (member tag (ert-test-tags test))))
+ universe))
+ (`(satisfies ,predicate)
+ (cl-remove-if-not predicate
+ (ert-select-tests 't universe)))))
(define-error 'ert-test-unbound "ERT test is unbound")