Function: ert-select-tests

ert-select-tests is a byte-compiled function defined in ert.el.gz.

Signature

(ert-select-tests SELECTOR UNIVERSE)

Documentation

Return a list of tests that match SELECTOR.

UNIVERSE specifies the set of tests to select from; it should be a list of tests, or t, which refers to all tests named by symbols in obarray.

Valid SELECTORs:

nil -- Selects the empty set.
t -- Selects UNIVERSE.
:new -- Selects all tests that have not been run yet.
:failed, :passed -- Select tests according to their most recent result.
:expected, :unexpected -- Select tests according to their most recent result.
a string -- A regular expression selecting all tests with matching names.
a test -- (i.e., an object of the ert-test data-type) Selects that test.
a symbol -- Selects the test that the symbol names, errors if none.
(member TESTS...) -- Selects the elements of TESTS, a list of tests
    or symbols naming tests.
(eql TEST) -- Selects TEST, a test or a symbol naming a test.
(and SELECTORS...) -- Selects the tests that match all SELECTORS.
(or SELECTORS...) -- Selects the tests that match any of the SELECTORS.
(not SELECTOR) -- Selects all tests that do not match SELECTOR.
(tag TAG) -- Selects all tests that have TAG on their tags list.
    A tag is an arbitrary label you can apply when you define a test.
(satisfies PREDICATE) -- Selects all tests that satisfy PREDICATE.
    PREDICATE is a function that takes an ert-test object as argument,
    and returns non-nil if it is selected.

Only selectors that require a superset of tests, such as (satisfies ...), strings, :new, etc. make use of UNIVERSE. Selectors that do not, such as (member ...), just return the set implied by them without checking whether it is really contained in UNIVERSE.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/ert.el.gz
(defun ert-select-tests (selector universe)
  "Return a list of tests that match SELECTOR.

UNIVERSE specifies the set of tests to select from; it should be a list
of tests, or t, which refers to all tests named by symbols in `obarray'.

Valid SELECTORs:

nil  -- Selects the empty set.
t    -- Selects UNIVERSE.
:new -- Selects all tests that have not been run yet.
:failed, :passed       -- Select tests according to their most recent result.
:expected, :unexpected -- Select tests according to their most recent result.
a string -- A regular expression selecting all tests with matching names.
a test   -- (i.e., an object of the ert-test data-type) Selects that test.
a symbol -- Selects the test that the symbol names, errors if none.
\(member TESTS...) -- Selects the elements of TESTS, a list of tests
    or symbols naming tests.
\(eql TEST) -- Selects TEST, a test or a symbol naming a test.
\(and SELECTORS...) -- Selects the tests that match all SELECTORS.
\(or SELECTORS...)  -- Selects the tests that match any of the SELECTORS.
\(not SELECTOR)     -- Selects all tests that do not match SELECTOR.
\(tag TAG) -- Selects all tests that have TAG on their tags list.
    A tag is an arbitrary label you can apply when you define a test.
\(satisfies PREDICATE) -- Selects all tests that satisfy PREDICATE.
    PREDICATE is a function that takes an ert-test object as argument,
    and returns non-nil if it is selected.

Only selectors that require a superset of tests, such
as (satisfies ...), strings, :new, etc. make use of UNIVERSE.
Selectors that do not, such as (member ...), just return the
set implied by them without checking whether it is really
contained in UNIVERSE."
  ;; This code needs to match the cases in
  ;; `ert--insert-human-readable-selector'.
  (pcase-exhaustive selector
    ('nil nil)
    ('t (pcase-exhaustive universe
          ((pred listp) universe)
          (`t (ert-select-tests "" universe))))
    (:new (ert-select-tests
           `(satisfies ,(lambda (test)
                          (null (ert-test-most-recent-result test))))
           universe))
    (:failed (ert-select-tests
              `(satisfies ,(lambda (test)
                             (ert-test-result-type-p
                              (ert-test-most-recent-result test)
                              ':failed)))
              universe))
    (:passed (ert-select-tests
              `(satisfies ,(lambda (test)
                             (ert-test-result-type-p
                              (ert-test-most-recent-result test)
                              ':passed)))
              universe))
    (:expected (ert-select-tests
                `(satisfies
                  ,(lambda (test)
                     (ert-test-result-expected-p
                      test
                      (ert-test-most-recent-result test))))
                universe))
    (:unexpected (ert-select-tests '(not :expected) universe))
    ((pred stringp)
     (pcase-exhaustive universe
       (`t (mapcar #'ert-get-test
                   (apropos-internal selector #'ert-test-boundp)))
       ((pred listp)
        (cl-remove-if-not (lambda (test)
                            (and (ert-test-name test)
                                 (string-match selector
                                               (symbol-name
                                                (ert-test-name test)))))
                          universe))))
    ((pred ert-test-p) (list selector))
    ((pred symbolp)
     (cl-assert (ert-test-boundp selector))
     (list (ert-get-test selector)))
    (`(,operator . ,operands)
     (cl-ecase operator
       (member
        (mapcar (lambda (purported-test)
                  (pcase-exhaustive purported-test
                    ((pred symbolp)
                     (cl-assert (ert-test-boundp 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)))))))