Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Some minor improvements. #16

Open
wants to merge 11 commits into from

3 participants

Jesse Alama Thomas M. Hermann Aaron France
Jesse Alama
  • Add a new ASSERT-NIL assertion form. This is, of course, equivalent to ASSERT-FALSE. But names matter; without knowing your API in full detail I found myself wanting to write ASSERT-NIL to check that a list of results is NIL, but I had to use ASSERT-FALSE, which is (psychologically) not the same thing (even though for the purpose of evaluating values logically falsity = NIL).
  • Clean up the various specializations on the RECORD-FAILURE generic function. On CCL 1.9, this particular practice of using CALL-NEXT-METHOD was leading to errors (specifically, the list of applicable methods was changing because the first argument was going from a known symbol [via the EQL specializer] to an unknown symbol, i.e., the list of applicable methods was changing from a list of length 2 to a list of length 1.
  • In .gitignore, ignore fasls generated by a (64-bit) CCL.
  • Use HASH-TABLE-P to do some sanity checks on the tags and test tables.
  • Trim some unnecessary end-of-line whitespace.
Thomas M. Hermann

I need to remember to test on CCL, it seems to check the CLOS more than other implementations. With respect to the CALL-NEXT-METHOD in record-failure, the specialized versions should probably be :BEFORE methods. I want to experiment with CCL because as I understand the Hyperspec and Keene, there is no reason the original implementation should not have worked. I may be missing something though. Regardless, making the methods :BEFORE methods should correct the error.

With respect to returning NIL from package-table instead of signalling an error, why do you like that approach? I prefer signalling an error because then the user can handle it however they wish using HANDLER-BIND or HANDLER-CASE. I don't like returning NIL and having to check for a hash-table everywhere that package-table is called.

With respect to assert-nil, let me think about it. I'd like to avoid creep in the number of assert forms. Other test libraries don't even bother with multiple assert forms.

Jesse Alama

Regarding package-table, I see your point about conditions. I took this approach to solve the following problem: I evaluate (lisp-unit:list-tests) and get, unexpectedly, an error about hash tables (and similarly with lisp-unit:list-tags). This seems to me like an error in the library; I don't see why I, as a user of the library, should be on the lookout for the case when no tests are defined. In that case (so the thinking goes), lisp-unit:list-tests should just return NIL, i.e., the empty list (set), rather than signaling an error. This seems like a library-internal issue: "no tests defined" could mean "the test table has been initialized but is empty" or it could mean "the test table hasn't even been initialized". From the outside, though, my intuition tells me that this is a distinction without a difference.

One could define a condition and then, inside the library, use a handler-case in lisp-unit:list-tests (and lisp-unit:list-tags) to return NIL if the condition arises. (I guess I'm saying that I am not in favor of exporting this condition from the library, though it could be used internally.)

Thomas M. Hermann

Ah, okay, I think I understand the issue. I didn't spend much time experimenting with the changes for 0.9.5, been a little busy with other tasks. Give me some time to experiment with the behavior, I'll get it cleaned up.

Thomas M. Hermann

Everything except for ASSERT-NIL has finally been taken care of. Haven't had time to mull over ASSERT-NIL.

Aaron France

This needs rebasing to master.

Will this be merged in? It looks like it has some useful stuff. I could help getting it back up to speed.

Thomas M. Hermann

Everything has been added except for ASSERT-NIL. I continue to waffle on the utility of the assertion and want to avoid interface bloat. I need to make a decision and close out this pull request.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
Showing with 104 additions and 63 deletions.
  1. +2 −1  .gitignore
  2. +102 −62 lisp-unit.lisp
3  .gitignore
View
@@ -1,4 +1,5 @@
# Ignore FASL files
*.fasl
*.lx64fsl
-*~
+*~
+*.dx64fsl
164 lisp-unit.lisp
View
@@ -3,22 +3,22 @@
#|
Copyright (c) 2004-2005 Christopher K. Riesbeck
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the "Software"),
-to deal in the Software without restriction, including without limitation
-the rights to use, copy, modify, merge, publish, distribute, sublicense,
-and/or sell copies of the Software, and to permit persons to whom the
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
-The above copyright notice and this permission notice shall be included
+The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
-OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
-THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
-OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
-ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
@@ -154,8 +154,7 @@ assertion.")
((gethash (find-package package) *test-db*))
(create
(setf (gethash package *test-db*) (make-hash-table)))
- (t (error "No tests defined for package ~A."
- (package-name package)))))
+ (t nil)))
;;; Global tags database
@@ -168,8 +167,7 @@ assertion.")
((gethash (find-package package) *tag-db*))
(create
(setf (gethash package *tag-db*) (make-hash-table)))
- (t (error "No tags defined for package ~A."
- (package-name package)))))
+ (t nil)))
;;; Unit test definition
@@ -220,6 +218,8 @@ assertion.")
(defmacro define-test (name &body body)
"Store the test in the test database."
+ (unless (symbolp name)
+ (error "The first argument to DEFINE-TEST should be a symbol."))
(let ((qname (gensym "NAME-")))
(multiple-value-bind (doc tag code) (parse-body body)
`(let* ((,qname (valid-test-name ',name))
@@ -240,25 +240,29 @@ assertion.")
(defun list-tests (&optional (package *package*))
"Return a list of the tests in package."
(let ((table (package-table package)))
- (when table
+ (when (hash-table-p table)
(loop for test-name being each hash-key in table
collect test-name))))
(defun test-documentation (name &optional (package *package*))
"Return the documentation for the test."
- (let ((unit-test (gethash name (package-table package))))
- (if (null unit-test)
- (warn "No test ~A in package ~A."
- name (package-name package))
- (doc unit-test))))
+ (let ((table (package-table package)))
+ (when (hash-table-p table)
+ (let ((unit-test (gethash name table)))
+ (if (null unit-test)
+ (warn "No test ~A in package ~A."
+ name (package-name package))
+ (doc unit-test))))))
(defun test-code (name &optional (package *package*))
"Returns the code stored for the test name."
- (let ((unit-test (gethash name (package-table package))))
- (if (null unit-test)
- (warn "No test ~A in package ~A."
- name (package-name package))
- (code unit-test))))
+ (let ((table (package-table package)))
+ (when (hash-table-p table)
+ (let ((unit-test (gethash name table)))
+ (if (null unit-test)
+ (warn "No test ~A in package ~A."
+ name (package-name package))
+ (code unit-test))))))
(defun remove-tests (&optional (names :all) (package *package*))
"Remove individual tests or entire sets."
@@ -277,6 +281,7 @@ assertion.")
name (package-name package)))
;; Remove tests from tags
(loop with tags = (package-tags package)
+ initially (unless (hash-table-p tags) (return nil))
for tag being each hash-key in tags
using (hash-value tagged-tests)
do
@@ -288,13 +293,16 @@ assertion.")
(defun %tests-from-all-tags (&optional (package *package*))
"Return all of the tests that have been tagged."
- (loop for tests being each hash-value in (package-tags package)
+ (loop with tags = (package-tags package)
+ initially (unless (hash-table-p tags) (return nil))
+ for tests being each hash-value in tags
nconc (copy-list tests) into all-tests
finally (return (delete-duplicates all-tests))))
(defun %tests-from-tags (tags &optional (package *package*))
"Return the tests associated with the tags."
(loop with table = (package-tags package)
+ initially (unless (hash-table-p table) (return nil))
for tag in tags
as tests = (gethash tag table)
if (null tests) do (warn "No tests tagged with ~S." tag)
@@ -304,7 +312,7 @@ assertion.")
(defun list-tags (&optional (package *package*))
"Return a list of the tags in package."
(let ((tags (package-tags package)))
- (when tags
+ (when (hash-table-p tags)
(loop for tag being each hash-key in tags collect tag))))
(defun tagged-tests (&optional (tags :all) (package *package*))
@@ -351,7 +359,7 @@ assertion.")
(defmacro assert-expands (expansion form &rest extras)
"Assert whether form expands to expansion."
- `(expand-assert :macro ,form
+ `(expand-assert :macro ,form
(expand-macro-form ,form nil)
',expansion ,extras))
@@ -359,6 +367,10 @@ assertion.")
"Assert whether the form is false."
`(expand-assert :result ,form ,form nil ,extras))
+(defmacro assert-nil (form &rest extras)
+ "Assert whether the form is NIL."
+ `(expand-assert :result ,form ,form nil ,extras))
+
(defmacro assert-equality (test expected form &rest extras)
"Assert whether expected and form are equal according to test."
`(expand-assert :equal ,form ,form ,expected ,extras :test ,test))
@@ -458,7 +470,12 @@ assertion.")
(defmethod record-failure ((type (eql :equal))
form actual expected extras test)
"Return an instance of an equal failure result."
- (call-next-method 'equal-result form actual expected extras test))
+ (make-instance 'equal-result
+ :form form
+ :actual actual
+ :expected expected
+ :extras extras
+ :test test))
(defclass error-result (failure-result)
()
@@ -475,7 +492,12 @@ assertion.")
(defmethod record-failure ((type (eql :error))
form actual expected extras test)
"Return an instance of an error failure result."
- (call-next-method 'error-result form actual expected extras test))
+ (make-instance 'error-result
+ :form form
+ :actual actual
+ :expected expected
+ :extras extras
+ :test test))
(defclass macro-result (failure-result)
()
@@ -508,7 +530,12 @@ assertion.")
(defmethod record-failure ((type (eql :macro))
form actual expected extras test)
"Return an instance of a macro failure result."
- (call-next-method 'macro-result form actual expected extras test))
+ (make-instance 'macro-result
+ :form form
+ :actual actual
+ :expected expected
+ :extras extras
+ :test test))
(defclass boolean-result (failure-result)
()
@@ -523,7 +550,12 @@ assertion.")
(defmethod record-failure ((type (eql :result))
form actual expected extras test)
"Return an instance of a boolean failure result."
- (call-next-method 'boolean-result form actual expected extras test))
+ (make-instance 'boolean-result
+ :form form
+ :actual actual
+ :expected expected
+ :extras extras
+ :test test))
(defclass output-result (failure-result)
()
@@ -540,7 +572,12 @@ assertion.")
(defmethod record-failure ((type (eql :output))
form actual expected extras test)
"Return an instance of an output failure result."
- (call-next-method 'output-result form actual expected extras test))
+ (make-instance 'output-result
+ :form form
+ :actual actual
+ :expected expected
+ :extras extras
+ :test test))
(defun internal-assert
(type form code-thunk expected-thunk extras test)
@@ -724,37 +761,40 @@ assertion.")
(defun %run-all-thunks (&optional (package *package*))
"Run all of the test thunks in the package."
- (loop
- with results = (make-instance 'test-results-db)
- for test-name being each hash-key in (package-table package)
- using (hash-value unit-test)
- if unit-test do
- (record-result test-name (code unit-test) results)
- else do
- (push test-name (missing-tests results))
- ;; Summarize and return the test results
- finally
- (when *signal-results*
- (signal 'test-run-complete :results results))
- (summarize-results results)
- (return results)))
+ (let ((table (package-table package)))
+ (when (hash-table-p table)
+ (loop
+ with results = (make-instance 'test-results-db)
+ for test-name being each hash-key in table
+ using (hash-value unit-test)
+ if unit-test do
+ (record-result test-name (code unit-test) results)
+ else do
+ (push test-name (missing-tests results))
+ ;; Summarize and return the test results
+ finally
+ (when *signal-results*
+ (signal 'test-run-complete :results results))
+ (summarize-results results)
+ (return results)))))
(defun %run-thunks (test-names &optional (package *package*))
"Run the list of test thunks in the package."
(loop
- with table = (package-table package)
- and results = (make-instance 'test-results-db)
- for test-name in test-names
- as unit-test = (gethash test-name table)
- if unit-test do
- (record-result test-name (code unit-test) results)
- else do
- (push test-name (missing-tests results))
- finally
- (when *signal-results*
- (signal 'test-run-complete :results results))
- (summarize-results results)
- (return results)))
+ with table = (package-table package)
+ with results = (make-instance 'test-results-db)
+ initially (unless (hash-table-p table) (return nil))
+ for test-name in test-names
+ as unit-test = (gethash test-name table)
+ if unit-test do
+ (record-result test-name (code unit-test) results)
+ else do
+ (push test-name (missing-tests results))
+ finally
+ (when *signal-results*
+ (signal 'test-run-complete :results results))
+ (summarize-results results)
+ (return results)))
(defun run-tests (&optional (test-names :all) (package *package*))
"Run the specified tests in package."
Something went wrong with that request. Please try again.