+(defun remove-from-suites (name &optional parents)
+ (when (get-test name)
+ ;; if this suite already exists, and its :IN some other suite, remove it.
+ (dolist (s (list-all-suites))
+ (let ((tests (tests s)))
+ (when (and (not (member (name s) parents :test #'eq))
+ (gethash name tests))
+ (remhash name tests))))))
+
+(defun add-to-suites (name suite parents)
+ (dolist (i parents)
+ (let ((in-suite (get-test i)))
+ (when (null in-suite)
+ (cerror "Create a new suite named ~A." "Unknown suite ~A." i)
+ (setf in-suite (make-suite i)
+ (get-test in-suite) in-suite))
+ (setf (gethash name (tests in-suite)) suite))))
+
+(defun remove-from-add-to-suites (test-name suite parent-suite)
+ ;; prevent cycles
+ (unless (eq suite parent-suite)
+ (let ((parents (ensure-list parent-suite)))
+ (remove-from-suites test-name parents)
+ (add-to-suites test-name suite parents))))
+
+(defun %update-suite (name suite description parent-suite fixture)
+ (setf (description suite) description)
+ (setf (fixture suite) fixture)
+ (remove-from-add-to-suites name suite parent-suite)
+ suite)
+