;;;; *** Other checks
-(defmacro skip (&rest reason)
- "Generates a TEST-SKIPPED result."
- `(progn
- (format *test-dribble* "s")
- (add-result 'test-skipped :reason (format nil ,@reason))))
-
(defmacro is-every (predicate &body clauses)
- "The input is either a list of lists, or a list of pairs. Generates (is (,predicate ,expr ,value))
- for each pair of elements or (is (,predicate ,expr ,value) ,@reason) for each list."
+ "Tests that all the elements of CLAUSES are equal, according to PREDICATE.
+
+If every element of CLAUSES is a cons we assume the `first` of each
+element is the expected value, and the `second` of each element is the
+actual value and generate a call to `IS` accordingly.
+
+If not every element of CLAUSES is a cons then we assume that each
+element is a value to pass to predicate (the 1 argument form of `IS`)"
`(progn
,@(if (every #'consp clauses)
(loop for (expected actual . reason) in clauses
(defmacro signals (condition-spec
&body body)
- "Generates a pass if BODY signals a condition of type
-CONDITION. BODY is evaluated in a block named NIL, CONDITION is
-not evaluated."
+ "Generates a pass if `BODY` signals a condition of type
+`CONDITION`. `BODY` is evaluated in a block named `NIL`, `CONDITION`
+is not evaluated."
(let ((block-name (gensym)))
(destructuring-bind (condition &optional reason-control reason-args)
(ensure-list condition-spec)
(return-from ,block-name nil)))))
(defmacro finishes (&body body)
- "Generates a pass if BODY executes to normal completion. In
-other words if body does signal, return-from or throw this test
-fails."
+ "Generates a pass if BODY executes to normal completion.
+
+In other words if body signals a condition (which is then handled),
+return-froms or throws this test fails."
`(let ((ok nil))
(unwind-protect
(progn
:test-expr ',body)))))
(defmacro pass (&rest message-args)
- "Simply generate a PASS."
+ "Generate a PASS."
`(add-result 'test-passed
:test-expr ',message-args
,@(when message-args
`(:reason (format nil ,@message-args)))))
(defmacro fail (&rest message-args)
- "Simply generate a FAIL."
+ "Generate a FAIL."
`(process-failure
:test-expr ',message-args
,@(when message-args
`(:reason (format nil ,@message-args)))))
+(defmacro skip (&rest message-args)
+ "Generates a SKIP result."
+ `(progn
+ (format *test-dribble* "s")
+ (add-result 'test-skipped :reason (format nil ,@message-args))))
+
;; Copyright (c) 2002-2003, Edward Marco Baringer
;; All rights reserved.
;;
FOR-ALL test including when the body is skipped due to failed
guard conditions.
-Since we have guard conditions we may get into infinite loops
-where the test code is never run due to the guards never
-returning true. This second run limit prevents that.")
+Since we have guard conditions we may get into infinite loops where
+the test code is never run due to the guards never returning
+true. This second limit prevents that from happening.")
(defmacro for-all (bindings &body body)
- "Bind BINDINGS to random variables and test BODY *num-trials* times.
-
-BINDINGS is a list of binding forms, each element is a list
-of (BINDING VALUE &optional GUARD). Value, which is evaluated
-once when the for-all is evaluated, must return a generator which
-be called each time BODY is evaluated. BINDING is either a symbol
-or a list which will be passed to destructuring-bind. GUARD is a
-form which, if present, stops BODY from executing when IT returns
-NIL. The GUARDS are evaluated after all the random data has been
-generated and they can refer to the current value of any
-binding. NB: Generator forms, unlike guard forms, can not contain
-references to the boud variables.
+ "Bind BINDINGS to random variables and execute BODY `*num-trials*` times.
+
+BINDINGS::
+
+A a list of binding forms, each element is a list of:
++
+ (BINDING VALUE &optional GUARD)
++
+VALUE, which is evaluated once when the for-all is evaluated, must
+return a generator which be called each time BODY is
+evaluated. BINDING is either a symbol or a list which will be passed
+to destructuring-bind. GUARD is a form which, if present, stops BODY
+from executing when it returns NIL. The GUARDS are evaluated after all
+the random data has been generated and they can refer to the current
+value of any binding.
++
+[NOTE]
+Generator forms, unlike guard forms, can not contain references to the
+bound variables.
+
+BODY::
+
+The code to run. Will be run `*NUM-TRIALS*` times (unless the `*MAX-TRIALS*` limit is reached).
Examples:
- (for-all ((a (gen-integer)))
- (is (integerp a)))
+--------------------------------
+\(for-all ((a (gen-integer)))
+ (is (integerp a)))
- (for-all ((a (gen-integer) (plusp a)))
- (is (integerp a))
- (is (plusp a)))
+\(for-all ((a (gen-integer) (plusp a)))
+ (is (integerp a))
+ (is (plusp a)))
- (for-all ((less (gen-integer))
- (more (gen-integer) (< less more)))
- (is (<= less more)))
+\(for-all ((less (gen-integer))
+ (more (gen-integer) (< less more)))
+ (is (<= less more)))
- (for-all (((a b) (gen-two-integers)))
- (is (integerp a))
- (is (integerp b)))"
+\(defun gen-two-integers ()
+ (lambda ()
+ (list (funcall (gen-integer))
+ (funcall (gen-integer)))))
+
+\(for-all (((a b) (gen-two-integers)))
+ (is (integerp a))
+ (is (integerp b)))
+--------------------------------
+"
(with-gensyms (test-lambda-args)
`(perform-random-testing
(list ,@(mapcar #'second bindings))
(defun gen-float (&key bound (type 'short-float) min max)
"Returns a generator which producs floats of type TYPE.
-BOUND, which defaults to the most-positive value of TYPE, constrains
-the results to be in the range (-BOUND, BOUND).
-
-MIN and MAX, if supplied, cause the returned float to be within the
-floating point interval (MIN, MAX). It is the caller's responsibility
-to ensure that the range between MIN and MAX is less than the
-requested type's maximum interval. MIN defaults to 0.0 (when only MAX
-is supplied), MAX defaults to MOST-POSITIVE-<TYPE> (when only MIN is
-supplied). This peculiar calling convention is designed for the common
-case of generating positive values below a known limit.
-
-NOTE: Since GEN-FLOAT is built on CL:RANDOM the distribution of
-returned values will be continuous, not discrete. In other words: the
-values will be evenly distributed across the specified numeric range,
-the distribution of possible floating point values, when seen as a
+BOUND::
+
+Constrains the results to be in the range (-BOUND, BOUND). Default
+value is the most-positive value of TYPE.
+
+MIN and MAX::
+
+If supplied, cause the returned float to be within the floating point
+interval (MIN, MAX). It is the caller's responsibility to ensure that
+the range between MIN and MAX is less than the requested type's
+maximum interval. MIN defaults to 0.0 (when only MAX is supplied), MAX
+defaults to MOST-POSITIVE-<TYPE> (when only MIN is supplied). This
+peculiar calling convention is designed for the common case of
+generating positive values below a known limit.
+
+TYPE::
+
+The type of the returned float. Defaults to `SHORT-FLOAT`. Effects the
+default values of BOUND, MIN and MAX.
+
+[NOTE]
+Since GEN-FLOAT is built on CL:RANDOM the distribution of returned
+values will be continuous, not discrete. In other words: the values
+will be evenly distributed across the specified numeric range, the
+distribution of possible floating point values, when seen as a
sequence of bits, will not be even."
(lambda ()
(flet ((rand (limit) (random (coerce limit type))))
(alphanumericp nil))
"Returns a generator of characters.
-CODE must be a generator of random integers. ALPHANUMERICP, if
-non-NIL, limits the returned chars to those which pass
-alphanumericp."
+CODE::
+
+A generater for random integers.
+
+CODE-LIMIT::
+
+If set only characters whose code-char is below this value will be
+returned.
+
+ALPHANUMERICP::
+
+Limits the returned chars to those which pass alphanumericp.
+"
(lambda ()
(loop
for count upfrom 0
finally (return char))))
(defun gen-string (&key (length (gen-integer :min 0 :max 80))
- (elements (gen-character))
- (element-type 'character))
- "Returns a generator which producs random strings. LENGTH must
-be a generator which producs integers, ELEMENTS must be a
-generator which produces characters of type ELEMENT-TYPE."
+ (elements (gen-character)))
+ "Returns a generator which producs random strings of characters.
+
+LENGTH::
+
+A random integer generator specifying how long to make the generated string.
+
+ELEMENTS::
+
+A random character generator which producs the characters in the
+string.
+"
+ (gen-buffer :length length
+ :element-type 'character
+ :elements elements))
+
+(defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
+ (element-type '(unsigned-byte 8))
+ (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
+ "Generates a random vector, defaults to a random (unsigned-byte 8)
+vector with elements between 0 and 255.
+
+LENGTH::
+
+The length of the buffer to create (a random integer generator)
+
+ELEMENT-TYPE::
+
+The type of array to create.
+
+ELEMENTS::
+
+The random element generator.
+"
(lambda ()
- (loop
- with length = (funcall length)
- with string = (make-string length :element-type element-type)
- for index below length
- do (setf (aref string index) (funcall elements))
- finally (return string))))
+ (let ((buffer (make-array (funcall length) :element-type element-type)))
+ (map-into buffer elements))))
(defun gen-list (&key (length (gen-integer :min 0 :max 10))
(elements (gen-integer :min -10 :max 10)))
- "Returns a generator which producs random lists. LENGTH must be
-an integer generator and ELEMENTS must be a generator which
-producs objects."
+ "Returns a generator which producs random lists.
+
+LENGTH::
+
+As with GEN-STRING, a random integer generator specifying the length of the list to create.
+
+ELEMENTS::
+
+A random object generator.
+"
(lambda ()
(loop
repeat (funcall length)
(lambda ()
(rec))))
-(defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
- (element-type '(unsigned-byte 8))
- (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
- (lambda ()
- (let ((buffer (make-array (funcall length) :element-type element-type)))
- (map-into buffer elements))))
-
(defun gen-one-element (&rest elements)
+ "Produces one randomly selected element of ELEMENTS.
+
+ELEMENTS::
+
+A list of objects (note: objects, not generators) to choose from."
(lambda ()
(nth (random (length elements)) elements)))
;;;; ** Public entry points
(defun run! (&optional (test-spec *suite*))
- "Equivalent to (explain! (run TEST-SPEC))."
+ "Shortcut for (explain! (run TEST-SPEC))."
(explain! (run test-spec)))
(defun explain! (result-list)
"Explain the results of RESULT-LIST using a
-detailed-text-explainer with output going to *test-dribble*"
+detailed-text-explainer with output going to `*test-dribble*`"
(explain (make-instance 'detailed-text-explainer) result-list *test-dribble*))
(defun debug! (&optional (test-spec *suite*))
(defmacro def-suite (name &key description (in nil in-p) (fixture nil fixture-p))
"Define a new test-suite named NAME.
+NAME::
+ The symbol naming the test.
+
+DESCRIPTION::
+ A string describing the contents/purpose of this suite.
+
IN (a symbol), if provided, causes this suite te be nested in the
-suite named by IN. NB: This macro is built on top of make-suite,
-as such it, like make-suite, will overrwrite any existing suite
-named NAME.
+suite named by `IN`. If `IN` is `NIL`, as opposed to not being passed
+at all, the new suite will not be a part of any existing suite.
+
+[NOTE]
+This macro is built on top of `make-suite` as such it, like `make-suite`,
+will overrwrite any existing suite named `NAME`.
DESCRIPTION is just a string.
-FIXTURE is the fixture argument (exactly like the :fixture argument to
+FIXTURE is the fixture argument (exactly like the `:fixture` argument to
def-test) to pass to tests in this suite."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(make-suite ',name
"The current test suite object")
(defmacro in-suite (suite-name)
- "Set the *suite* special variable so that all tests defined
+ "Set the `*suite*` special variable so that all tests defined
after the execution of this form are, unless specified otherwise,
-in the test-suite named SUITE-NAME.
+in the test-suite named `SUITE-NAME`.
-See also: DEF-SUITE *SUITE*"
+See also: `DEF-SUITE` and `*SUITE*`. "
`(eval-when (:compile-toplevel :load-toplevel :execute)
(%in-suite ,suite-name)))
-(defmacro in-suite* (suite-name &key (in nil in-p))
- "Just like in-suite, but silently creates missing suites."
+(defmacro in-suite* (suite-name &rest def-suite-args)
+ "Same effect as `IN-SUITE`, but if `SUITE-NAME` does not exist it
+will be created (as per DEF-SUITE)"
`(%in-suite ,suite-name
- ,@(when in-p `(:in ,in))
- :fail-on-error nil))
+ :fail-on-error nil
+ ,@def-suite-args))
-(defmacro %in-suite (suite-name &key (fail-on-error t) (in nil in-p))
+(defmacro %in-suite (suite-name &rest def-suite-args &key fail-on-error &allow-other-keys)
+ (declare (ignore fail-on-error))
(with-gensyms (suite)
- `(progn
- (if-let (,suite (get-test ',suite-name))
- (setf *suite* ,suite)
- (progn
- (when ,fail-on-error
- (cerror "Create a new suite named ~A."
- "Unknown suite ~A." ',suite-name))
- (setf (get-test ',suite-name) (make-suite ',suite-name ,@(when in-p `(:in ',in)))
- *suite* (get-test ',suite-name))))
- ',suite-name)))
+ (let ((fail-on-error (getf def-suite-args :fail-on-error t)))
+ (remf def-suite-args :fail-on-error)
+ `(progn
+ (if-let (,suite (get-test ',suite-name))
+ (setf *suite* ,suite)
+ (progn
+ (when ,fail-on-error
+ (cerror "Create a new suite named ~A."
+ "Unknown suite ~A." ',suite-name))
+ (setf (get-test ',suite-name) (make-suite ',suite-name ,@def-suite-args)
+ *suite* (get-test ',suite-name))))
+ ',suite-name))))
;; Copyright (c) 2002-2003, Edward Marco Baringer
;; All rights reserved.
(defvar *test*
(make-hash-table :test 'eql)
- "Lookup table mapping test (and test suite)
- names to objects.")
+ "Lookup table mapping test (and test suite) names to objects.")
(defun get-test (key &key default error)
"Finds the test named KEY. If KEY is a testable-object (a test case
(ensure-list name)
`(def-test ,name (,@args) ,@body)))
-(defmacro def-test (name (&key depends-on
- (suite nil suite-p)
+(defmacro def-test (name (&key (suite nil suite-p)
fixture
(compile-at :run-time)
+ depends-on
profile)
&body body)
"Create a test named NAME.
-NAME is the symbol which names the test.
+NAME (a symbol)::
+ The name of the test.
-DEPENDS-ON is a list of the form:
+SUITE (a test name)::
+ The suite to put the test under. It defaults to *SUITE* (which
+ itself defaults to the default global suite).
-\(AND . test-names) - This test is run only if all of the tests
- in TEST-NAMES have passed, otherwise a single test-skipped
- result is generated.
+FIXTURE::
+ The name of the fixture to use for this test. See `WITH-FIXTURE` for
+ details on fixtures.
-\(OR . test-names) - If any of TEST-NAMES has passed this test is
- run, otherwise a test-skipped result is generated.
+COMPILE-AT (a keyword)::
+ When the body of this test should be compiled. By default, or when
+ `:compile-at` is `:run-time`, test bodies are only compiled before
+ they are run. Set this to to `:definition-time` to force
+ compilation, and errors/warnings, to be done at compile time.
-\(NOT test-name) - This is test is run only if TEST-NAME failed.
+DEPENDS-ON::
+ A list, or a symbol, which specifies the relationship between this
+ test and other tests. These conditions, `AND`, `OR` and `NOT` can be
+ combined to produce complex dependencies (whethere this is something
+ you should actually be doing is a question for another day).
-AND, OR and NOT can be combined to produce complex dependencies.
+ `(and &rest TEST-NAMES)`:::
+ This test is run only if all of the tests in TEST-NAMES have
+ passed, otherwise a single test-skipped result is generated.
-If DEPENDS-ON is a symbol it is interpreted as `(AND
-,depends-on), this is accomadate the common case of one test
-depending on another.
+ `(or &rest TEST-NAMES)`:::
+ If any of TEST-NAMES has passed this test is run, otherwise a
+ test-skipped result is generated.
-SUITE is the suite to put the test under. It defaults to
-*SUITE* (which itself defaults to the default global suite).
+ `(NOT TEST-NAME`:::
+ This is test is run only if TEST-NAME failed.
-FIXTURE specifies a fixture to wrap the body in.
+ __a-symbol__:::
+ Shorthand for `(AND a-symbol)`
-If PROFILE is T profiling information will be collected as well.
-
-COMPILE-AT can be either :RUN-TIME, in which case compilation of the
-test code will be delayed until the test is run, or :DEFINITION-TIME,
-in which case the code will be compiled when the DEF-TEST form itself
-is compiled."
+PROFILE::
+ When non-`NIL` profiling information will be collected as well."
(check-type compile-at (member :run-time :definition-time))
(multiple-value-bind (forms decls docstring)
(parse-body body :documentation t :whole name)
projects / fiveam.git / commitdiff