Docstring fixups (added some clarificatino here and there, reformatted into asciidoc...

diff --git a/src/check.lisp b/src/check.lisp
index 9b7ad63..8c9685f 100644 (file)
--- a/src/check.lisp
+++ b/src/check.lisp
@@ -190,15 +190,15 @@ string."
 
 ;;;; *** Other checks
 
 
 ;;;; *** 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)
 (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
   `(progn
      ,@(if (every #'consp clauses)
            (loop for (expected actual . reason) in clauses

@@ -239,9 +239,9 @@ string."
 
 (defmacro signals (condition-spec
                    &body body)
 
 (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)
   (let ((block-name (gensym)))
     (destructuring-bind (condition &optional reason-control reason-args)
         (ensure-list condition-spec)

@@ -262,9 +262,10 @@ not evaluated."
          (return-from ,block-name nil)))))
 
 (defmacro finishes (&body body)
          (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
   `(let ((ok nil))
      (unwind-protect
           (progn

@@ -277,19 +278,25 @@ fails."
             :test-expr ',body)))))
 
 (defmacro pass (&rest message-args)
             :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)
   `(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)))))
 
   `(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.
 ;;
 ;; Copyright (c) 2002-2003, Edward Marco Baringer
 ;; All rights reserved.
 ;;

diff --git a/src/random.lisp b/src/random.lisp
index 3813f43..1a83349 100644 (file)
--- a/src/random.lisp
+++ b/src/random.lisp
@@ -32,40 +32,59 @@
   FOR-ALL test including when the body is skipped due to failed
   guard conditions.
 
   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)
 
 (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:
 
 
 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))
   (with-gensyms (test-lambda-args)
     `(perform-random-testing
       (list ,@(mapcar #'second bindings))

@@ -184,21 +203,31 @@ than or equal to MIN and less than or equal to MIN."
 (defun gen-float (&key bound (type 'short-float) min max)
   "Returns a generator which producs floats of type TYPE. 
 
 (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))))
 sequence of bits, will not be even."
   (lambda ()
     (flet ((rand (limit) (random (coerce limit type))))

@@ -224,9 +253,19 @@ sequence of bits, will not be even."
                            (alphanumericp nil))
   "Returns a generator of characters.
 
                            (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
   (lambda ()
     (loop
        for count upfrom 0

@@ -240,24 +279,56 @@ alphanumericp."
        finally (return char))))
 
 (defun gen-string (&key (length (gen-integer :min 0 :max 80))
        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 ()
   (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)))
 
 (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 ()
     (loop
        repeat (funcall length)

@@ -278,14 +349,12 @@ will produce the elements."
     (lambda ()
       (rec))))
 
     (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)
 (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)))
 
   (lambda ()
     (nth (random (length elements)) elements)))
 

diff --git a/src/run.lisp b/src/run.lisp
index 8acdd5e..6e50213 100644 (file)
--- a/src/run.lisp
+++ b/src/run.lisp
@@ -221,12 +221,12 @@ run."))
 ;;;; ** Public entry points
 
 (defun run! (&optional (test-spec *suite*))
 ;;;; ** 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
   (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*))
   (explain (make-instance 'detailed-text-explainer) result-list *test-dribble*))
 
 (defun debug! (&optional (test-spec *suite*))

diff --git a/src/suite.lisp b/src/suite.lisp
index 8fd2218..243a5f1 100644 (file)
--- a/src/suite.lisp
+++ b/src/suite.lisp
@@ -21,14 +21,23 @@
 (defmacro def-suite (name &key description (in nil in-p) (fixture nil fixture-p))
   "Define a new test-suite named NAME.
 
 (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
 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.
 
 
 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
 def-test) to pass to tests in this suite."
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (make-suite ',name

@@ -79,32 +88,36 @@ Overrides any existing suite named NAME."
   "The current test suite object")
 
 (defmacro in-suite (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,
 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)))
 
   `(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
   `(%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)
   (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.
 
 ;; Copyright (c) 2002-2003, Edward Marco Baringer
 ;; All rights reserved.

diff --git a/src/test.lisp b/src/test.lisp
index 0bfac1f..e874dc8 100644 (file)
--- a/src/test.lisp
+++ b/src/test.lisp
@@ -13,8 +13,7 @@
 
 (defvar *test*
   (make-hash-table :test 'eql)
 
 (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
 
 (defun get-test (key &key default error)
   "Finds the test named KEY. If KEY is a testable-object (a test case

@@ -47,44 +46,53 @@ named KEY in the *TEST* hash table."
       (ensure-list name)
     `(def-test ,name (,@args) ,@body)))
 
       (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)
                                fixture
                                (compile-at :run-time)

+                               depends-on

                                profile)
                     &body body)
   "Create a test named NAME.
 
                                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)
   (check-type compile-at (member :run-time :definition-time))
   (multiple-value-bind (forms decls docstring)
       (parse-body body :documentation t :whole name)