From 9455689becf43e8ded4944a697ff68293643a9bb Mon Sep 17 00:00:00 2001 From: John Kirollos Date: Thu, 4 Dec 2025 04:07:37 +0200 Subject: [PATCH] Add utility function to remove test(s) from a specific suite. The scenario that showed the need to add this function: - add some experimental test cases, with inconvenient test keys (e.g. a string or an uninterned symbol) - fiveam will add the tests without signaling any errors (this would also need to be handled in separate commit; i.e., to reject attempts to define tests with bad test key. - run test suites as usual, and you'll have some problems: tests with string keys will result in method dispatch errors, and tests with uninterned symbol keys will get stuck in the tests hash table, without being able to modify or clean them up using REM-TEST. This added utility function, REM-TESTS, allows cleaning up tests such as these ones. Check its docstring for more details. --- src/test.lisp | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/src/test.lisp b/src/test.lisp index 579d985..31aa687 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -29,6 +29,31 @@ (deletef (%test-names *test*) key) (remhash key (%tests *test*))) +(defun rem-tests (key &key test-suite-key test-sym-name) + "Remove test(s) identified by `key` from suite identified by `test-suite-key` (or from suite specified +by `*suite*` if not provided or provided with NIL value). Equality test is EQL by default, and the +`test-sym-name` keyword argument may be used to override it with string equality (case-insensitive). This +is convenient in case the test to be removed was added with an uninterned symbol as identity (e.g. by +mistake). Note that in the case of uninterned symbol, multiple entries could be present to the hash table +with the same symbol name. This is since each symbol has a different address. This function would remove +all such entries (hence, the s in the function name)." + (labels ((key-string-equal-p (key-in key-iter) + "Equality test for key, based on string value (case-insensitive)." + (string-equal (string key-in) (string key-iter)))) + (let* ((test-suite (if test-suite-key + (get-test test-suite-key) + *suite*)) + (test-bundle (tests test-suite)) + (tests-map (%tests test-bundle)) + (result nil)) + (deletef (%test-names test-bundle) key :test (or (and test-sym-name #'key-string-equal-p) #'eql)) + (if test-sym-name + (loop for k being the hash-keys of tests-map + do (when (key-string-equal-p key k) + (setf result (remhash k tests-map)))) + (setf result (remhash key tests-map))) + result))) + (defun test-names () (reverse (%test-names *test*)))