From 233a62ddb5da0f82d468330c199c137f3ef92788 Mon Sep 17 00:00:00 2001 From: Marco Baringer Date: Fri, 30 Nov 2012 19:27:17 +0100 Subject: [PATCH] Docstring fixups (added some clarificatino here and there, reformatted into asciidoc 'style') --- src/check.lisp | 39 ++++++----- src/random.lisp | 199 +++++++++++++++++++++++++++++++++++++------------------ src/run.lisp | 4 +- src/suite.lisp | 57 ++++++++++------ src/test.lisp | 58 +++++++++------- 5 files changed, 227 insertions(+), 130 deletions(-) diff --git a/src/check.lisp b/src/check.lisp index 9b7ad63..8c9685f 100644 --- a/src/check.lisp +++ b/src/check.lisp @@ -190,15 +190,15 @@ string." ;;;; *** 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 @@ -239,9 +239,9 @@ string." (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) @@ -262,9 +262,10 @@ not evaluated." (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 @@ -277,19 +278,25 @@ fails." :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. ;; diff --git a/src/random.lisp b/src/random.lisp index 3813f43..1a83349 100644 --- 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. -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)) @@ -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. -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- (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- (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)))) @@ -224,9 +253,19 @@ sequence of bits, will not be even." (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 @@ -240,24 +279,56 @@ alphanumericp." 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) @@ -278,14 +349,12 @@ will produce the elements." (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))) diff --git a/src/run.lisp b/src/run.lisp index 8acdd5e..6e50213 100644 --- a/src/run.lisp +++ b/src/run.lisp @@ -221,12 +221,12 @@ run.")) ;;;; ** 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*)) diff --git a/src/suite.lisp b/src/suite.lisp index 8fd2218..243a5f1 100644 --- 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. +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 @@ -79,32 +88,36 @@ Overrides any existing suite named 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. diff --git a/src/test.lisp b/src/test.lisp index 0bfac1f..e874dc8 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -13,8 +13,7 @@ (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 @@ -47,44 +46,53 @@ named KEY in the *TEST* hash table." (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) -- 1.7.10.4