From 12c6e1daab52d528fbbbf0d0e4a7e6f0fec548d9 Mon Sep 17 00:00:00 2001 From: Marco Baringer Date: Thu, 29 Nov 2012 11:58:16 +0100 Subject: [PATCH] Added :default and :error arguments to get-test (instead of just an &optional default argument) Nowhere in fiveam's code was get-test called with the default argument. --- src/classes.lisp | 4 ++++ src/test.lisp | 15 +++++++++++++-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/classes.lisp b/src/classes.lisp index dd33429..7404c49 100644 --- a/src/classes.lisp +++ b/src/classes.lisp @@ -28,6 +28,10 @@ information will be collected when the test is run."))) +(defgeneric testable-object-p (object) + (:method ((object testable-object)) t) + (:method ((object t)) nil)) + (defmethod print-object ((test testable-object) stream) (print-unreadable-object (test stream :type t :identity t) (format stream "~S" (name test)))) diff --git a/src/test.lisp b/src/test.lisp index 02296c1..3d79595 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -16,8 +16,19 @@ "Lookup table mapping test (and test suite) names to objects.") -(defun get-test (key &optional default) - (gethash key *test* default)) +(defun get-test (key &key default error) + "Finds the test named KEY. If KEY is a testable-object (a test case +or a test suite) then we just return KEY, otherwise we look for a test +named KEY in the *TEST* hash table." + (if (testable-object-p key) + key + (multiple-value-bind (value foundp) + (gethash key *test*) + (if foundp + value + (if error + (error "Unable to find test named ~S." key) + default))))) (defun (setf get-test) (value key) (setf (gethash key *test*) value)) -- 1.7.10.4