Bring in typo fixes; run-all-tests and friends and nicer IS output.
Conflicts:
src/check.lisp
src/run.lisp
src/suite.lisp
-Copyright (c) 2003-2006, Edward Marco Baringer
+Copyright (c) 2012 Stelian Ionescu
+Copyright (c) 2003-2012, Edward Marco Baringer
+
All rights reserved.
Redistribution and use in source and binary forms, with or without
package :it.bese.fiveam (nicknamed 5AM).
The mailing list for FiveAM is fiveam-devel@common-lisp.net
-
-All the code is Copyright (C) 2002-2006 Edward Marco Baringer.
--- /dev/null
+(in-package :smake-user)
+
+(defvar *asciidoc-root* #P"/usr/local/etc/asciidoc/")
+
+(program "asciidoc")
+
+(defun static-file (name &optional source destination)
+
+ (cond
+ ((null source)
+ (setf source (source-pathname name)))
+ ((stringp source)
+ (setf source (source-pathname source))))
+
+ (cond
+ ((null destination)
+ (setf destination (build-pathname name)))
+ ((stringp destination)
+ (setf destination (build-pathname destination))))
+
+ (target* `(static-file ,name) ()
+ (when (file-newer-p source destination)
+ (path:cp source destination))))
+
+(static-file "asciidoc.css" (path:catfile *asciidoc-root* "stylesheets/" "asciidoc.css"))
+
+(static-file "asciidoc.js" (path:catfile *asciidoc-root* "javascripts/" "asciidoc.js"))
+
+(static-file "fiveam.css")
+
+(target (static-directory "asciidoc/images") ()
+ (ensure-directories-exist (build-pathname "images/icons/callouts/"))
+ (dolist (src (directory (path:catfile *asciidoc-root* "images/" "icons/" "callouts/" "*.png")))
+ (let ((dst (build-pathname (path:catfile "images/icons/callouts/" (path:basename src)))))
+ (when (file-newer-p src dst)
+ (path:cp src dst)))))
+
+(defun asciidoc.html (source &optional requires)
+ (target* `(asciidoc ,source) (:requires (append requires
+ '((program "asciidoc")
+ (static-file "asciidoc.js")
+ (static-file "asciidoc.css")
+ (static-file "fiveam.css")
+ (static-directory "asciidoc/images"))))
+ (when (file-newer-p (source-pathname source) (build-pathname source :type "html"))
+ (unless (path:-e (build-pathname source))
+ (sys `(ln -s ,(source-pathname source) ,(build-pathname source))))
+ (sys `(asciidoc -o ,(build-pathname source :type "html") ,(build-pathname source))))))
+
+(target "docstrings" ()
+ (unless (path:-d (build-pathname "docstrings/"))
+ (sys `(ccl64 --load ../extract-docstrings.lisp))
+ (sys `(rm -f ,(build-pathname "manual.html") ,(build-pathname "tutorial.html")))))
+
+(asciidoc.html "manual.txt" '("docstrings"))
+(asciidoc.html "tutorial.txt" '((asciidoc "manual.txt")))
+
+(target "documentation" (:requires '((asciidoc "manual.txt")
+ (asciidoc "tutorial.txt"))))
+
+(target "all" (:requires '("documentation")))
+
--- /dev/null
+(quicklisp:quickload :iterate)
+(quicklisp:quickload :alexandria)
+
+(defpackage :it.bese.fiveam.documentation
+ (:use :common-lisp :iterate :alexandria))
+
+(in-package :it.bese.fiveam.documentation)
+
+(quicklisp:quickload :cl-fad)
+(quicklisp:quickload :cl-ppcre)
+(quicklisp:quickload :closer-mop)
+
+(quicklisp:quickload :fiveam)
+
+(defvar *slime-root* #P"/Users/mb/m/.emacs/slime/")
+
+(load (path:catfile *slime-root* "swank.asd"))
+(asdf:load-system :swank)
+
+(ensure-directories-exist "./docstrings/")
+
+(defun symbol-name-to-pathname (symbol type)
+ (let ((name (if (symbolp symbol)
+ (symbol-name symbol)
+ (string symbol))))
+ (setf name (cl-ppcre:regex-replace-all "\\*" name "-STAR-")
+ name (cl-ppcre:regex-replace-all "\\+" name "-PLUS-")
+ name (cl-ppcre:regex-replace-all "\\~" name "-TILDE-")
+ name (cl-ppcre:regex-replace-all "\\!" name "-EPOINT-")
+ name (cl-ppcre:regex-replace-all "\\!" name "-QMARK-"))
+ (concatenate 'string
+ (ecase type (function "OP") (type "TYPE") (arglist "ARGLIST") (variable "VAR"))
+ "_"
+ name)))
+
+(defun output-docstring (name type)
+ (let ((docstring (documentation name type)))
+ (when docstring
+ (with-output-to-file (d (path:catfile "./docstrings/" (format nil "~A.txt" (symbol-name-to-pathname name type))) :if-exists :supersede)
+ (write-string docstring d)))))
+
+(iter
+ (with *package* = (find-package :fiveam))
+ (for i in-package (find-package :fiveam) external-only t)
+
+ (output-docstring i 'function)
+ (when (documentation i 'function)
+ (with-output-to-file (d (path:catfile "./docstrings/" (format nil "~A.txt" (symbol-name-to-pathname i 'arglist))))
+ (write-string (string-downcase (format nil "~A~{ __~A__~}~%~%" i (swank-backend:arglist i)))
+ d)))
+ (output-docstring i 'variable))
+
+(output-docstring '5am::test-suite 'type)
+(output-docstring '5am::testable-object 'type)
+(output-docstring '5am::test-case 'type)
--- /dev/null
+body {
+ width: 560px;
+ margin-left: auto;
+ margin-right: auto;
+ margin-top: 20px;
+}
--- /dev/null
+= FiveAM Manual =
+Marco Baringer <mb@bese.it>
+Fall/Winter 2012
+:Author Initials: MB
+:toc:
+:icons:
+:numbered:
+:website: http://common-lisp.net/project/fiveam
+:stylesheet: fiveam.css
+:linkcss:
+
+== Introduction ==
+
+=== The Super Brief Introduction ===
+
+FiveAM is a testing framework. See the xref:API_REFERENCE[api] for
+details.
+
+=== An Ever So Slightly Longer Introduction ===
+
+You use define some xref:TESTS[tests] (using
+xref:OP_DEF-TEST[`def-test`]), each of which consists of some
+xref:CHECKS[checks] (with xref:OP_IS[`is`] and friends) which can pass
+or fail; you xref:RUNNING_TESTS[run] some tests (using
+xref:OP_RUN-EPOINT-[run!] and friends) and you look at the results
+(probably using xref:OP_RUN-EPOINT-[run!] again). Rinse, lather,
+repeat.
+
+=== The Real Introduction ===
+
+FiveAM is a testing framework, this is a rather vague concept, so
+before talking about how to use FiveAM it's worth knowing what task(s)
+FiveAM was built to do and, in particular, which styles of testing
+FiveAM was designed to facilitate:
+
+`test driven development`:: sometimes you know what you're trying to
+ do (lucky you) and you can figure out what your code should do
+ before you've written the code itself. The idea here is that you
+ write a bunch of tests and when all these test pass your code is
+ done.
+
+`interactive testing`:: sometimes as you're writing code you'll see
+ certain constraints that your code has to meet. For example you'll
+ realize there's a specific border case your code, which you're
+ probably not even done writing, has to deal with. In this work flow
+ you'll write code and tests more or less simultaneously and by the
+ time you're satisfied that your code does what it should you'll have
+ a set of tests which prove that it does what you think it does.
+
+`regression testing`:: sometimes you're pretty confident, just by
+ looking at the code, that your program does what it should, but you
+ want an automatic way to make sure that it continues to do what it
+ does even if (when) you change other parts of the code.
+
+[NOTE]
+There's also `beaviour driven development`. this works under
+the assumption that you can write tests in a natural-ish lanugage and
+they'll be easier to maintain than tests writen in code (have we
+learned nothing from cobol?). FiveAM does not, in its current
+implementation, support link:http://cukes.info/[cucumber] like
+behaviour driven development. patches welcome (they'll get laughed at
+at first, but they'll get applied, and then they'll get used, and then
+they'll be an essential part of fiveam itself...)
+
+=== Words ===
+
+Since there are far many more testing frameworks than there are words
+for talking about testing frameworks, the same words end up meaning
+different things in different frameworks. Just to be clear, here are
+the words fiveam uses:
+
+`check`:: a single expression which has an expected value.
+
+`test`:: a set of checks which we want to always run together.
+
+`suite`:: a group of tests we often want to run all at once.
+
+[[TESTS]]
+== Tests ==
+
+Tests are created with the xref:OP_DEF-TEST[`def-test`] macro and
+consist of:
+
+A name::
+
+Because everything deserves a name. Names in FiveAM are symbols (or
+anything that can be sensibly put in an `eql` hash table) and they are
+used both to select which test to run (as arguments to `run!` and
+family) and when reporting test failures.
+
+A body::
+
+Every test has a function which is the actual code that gets executed
+when the test is run. This code, whatever it is, will, bugs aside,
+xref:CHECKS[create a set of test result objects] (failures, successes
+and skips) and store these in a few dynamic variables (you don't need
+to worry about those).
++
+The body is actually the only real part of the test, everything else
+is administrativia. Sometimes usefel administrativia, but none the
+less overhead.
+
+A suite::
+
+Generally speaking you'll have so many tests that you'll not want to
+run them all every single time you need to run one of them (automated
+regression testing is another use case). Tests can be grouped into
+suites, and suites can also be grouped into suites, and suites have
+names, so by specfying the name of a suite we only run those tests
+that are a part of that suite.
++
+Unless otherwise specified tests add themselves to the xref:THE_CURRENT_SUITE[current suite].
+
+There are two other properties, also set via parameters to
+xref:OP_DEF-TEST[`def-test`], which influence how the tests are
+run:
+
+When to compile the test::
+
+Often enough, when working with lisp macros especially, it's useful to
+delay compilation of the test's body until the test is run. A useful
+side effect of this delay is that the code will be recompiled every
+time its run, so if the macro definition has changed that will be
+picked up at the next run of the test. While this is the default mode
+of operation for FiveAM it can be turned off and tests will be
+compiled at the 'normal' time (when the enclosing def-test form is
+compiled).
+
+Whether to run the test at all::
+
+Sometimes, but far less often than the designer of FiveAM expected,
+it's useful to run a test only when some other test passes. The
+assumption being that if the lower level tests have failed there's no
+point in cluttering up the output by running the higher level tests as
+well.
++
+YMMV. (i got really bad mileage out of this feature)
+
+[[CHECKS]]
+== Checks ==
+
+At the heart of every test is something which compares the result of
+some code to some expected value, in FiveAM these are called
+checks. All checks in FiveAM do something, exactly what depends on the
+check, and then either:
+
+. generate a "this check passed" result
+
+. generate a "this check failed" result and a corresponding failure
+ description message.
+
+. generate a "for some reason this check was skipped" result.
+
+All checks take, as an optional argument, so called "reason format
+control arguments." Should the check fail (or be skipped) these
+arguments will be passed to format, via something like `(curry
+#'format nil)`, and the result will be used as the
+explanation/description of the failure.
+
+When it comes to the actual check functions themeselves, there are
+three basic kinds:
+
+. xref:CHECKING_RETURN_VALUES[those that take a value and compare it
+to another value]
+
+. xref:CHECKING_CONTROL_FLOW[those that make sure the program's
+execution takes, or does not take, a certain path]
+
+. xref:ARBITRARY_CHECK_RESULTS[those that just force a success or
+failure to be recorded].
+
+[[CHECKING_RETURN_VALUES]]
+=== Checking return values ===
+
+xref:OP_IS[`IS`], xref:OP_IS-TRUE[`IS-TRUE`],
+xref:OP_IS[`IS-FALSE`] will take one form and compare its return
+value to some known value (the so called expected vaule) and report an
+error if these two are not equal.
+
+--------------------------------
+;; Pass if (+ 2 2) is = to 5
+(is (= 5 (+ 2 2)))
+;; Pass if (zerop 0) is not-NIL
+(is-true (zerop 0))
+;; Pass if (zerop 1) is NIL
+(is-false (zerop 1))
+--------------------------------
+
+Often enough we want to test a set of expected values against a set of
+test values using the same operator. If, for example, we were
+implementing a string formatting functions, then `IS-EVERY` provides a
+concise way to line up N different inputs along with their expected
+outputs. For example, let's say we were testing `cl:+`, we could setup
+a list of tests like this:
+
+--------------------------------
+(is-every #'= (5 (+ 2 2))
+ (0 (+ -1 1))
+ (-1 (+ -1 0))
+ (1 (+ 0 1))
+ (1 (+ 1 0)))
+--------------------------------
+
+We'd do this instead of writing out 5 seperate `IS` or `IS-TRUE`
+checks.
+
+[[CHECKING_CONTROL_FLOW]]
+=== Checking control flow ===
+
+xref:OP_SIGNALS[`SIGNALS`] and xref:OP_FINISHES[`FINISHES`] create
+pass/fail results depending on whether their body code did or did not
+terminat normally.
+
+Both of these checks assume that there is a single block of code and
+it either runs to completion or it doesn't. Sometimes though the logic
+is more complex and you can't easily represent it as a single progn
+with a flag at the end. See xref:ARBITRARY_CHECK_RESULTS[below].
+
+[[ARBITRARY_CHECK_RESULTS]]
+=== Recording arbitrary test results ===
+
+Very simply these three checks, xref:OP_PASS[`PASS`],
+xref:OP_FAIL[`FAIL`] and xref:OP_SKIP[`SKIP`] generate the specified
+result. They're intended to be used when what we're trying to test
+doesn't quite fit into any of the two preceding ways of working.
+
+== Suites ==
+
+Suites serve to group tests into managable (and runnable) chunks, they
+make it easy to have many tests defined, but only run those the
+pertain to what we're currently working on. Suites, like tests, have a
+name which can be used to retrieve the suite, and running a suite
+simply causes all of the suite's tests to be run, if the suite
+contains other suites, than those are run as well (and so on and so
+on).
+
+There is one suite that's a little special (in so far as it always
+exists), the `T` suite. If you ignore suites completely, which is a
+good idea at first or for small(ish) code bases, you're actually
+putting all your tests into the `T` suite.
+
+=== Creating Suites ===
+
+Suites are created in one of two ways: Either explicitly via the
+xref:OP_DEF-SUITE[`def-suite`] macro, or implicity via the
+xref:OP_DEF-SUITE-STAR-[`def-suite*`] and/or
+xref:OP_IN-SUITE-STAR-[`in-suite*`] macros:
+
+Suites, very much like tests, have a name (which is globally unique)
+which can be used to retrieve the suite (so that you can run it), and,
+most of the time, suites are part of a suite (the exception being the
+special suite `T`, which is never a part of any suite).
+
+[[THE_CURRENT_SUITE]]
+=== The Current Suite ===
+
+FiveAM also has the concept of a current suite and everytime a test is
+created it adds itself to the current suite's set of tests. The
+`IN-SUITE` and `IN-SUITE*` macros, in a similar fashion to
+`IN-PACKAGE`, change the current suite.
+
+Unless changed via `IN-SUITE` and `IN-SUITE*` the current suite is the
+`T` suite.
+
+Having a default current suite allows developers to ignore suites
+completly and still have FiveAM's suite mechanism in place if they
+want to add suites in later.
+
+[[RUNNING_SUITES]]
+=== Running Suites ===
+
+When a suite is run we do nothing more than run all the tests (and any
+other suites) in the named suite. And, on one level, that's it, suites
+allow you run a whole set of tests at once just by passing in the name
+of the suite.
+
+[[RUNNING_TESTS]]
+== Running Tests ==
+
+The general interface is `run`, this takes a set of tests (or symbol
+that name tests or suites) and returns a list of test results (one
+element for each test run). The output of `run` is, generally, passed
+to the `explain` function which, given an explainer object, produces
+some human readable text describing the test failures. 99% of the time
+a human will be using 5am (as opposed to a continuous integration bot)
+they'll want to run the tests and immediately see the results with
+detailed failure info, this can be done in one step via: `run!` (see
+the first example).
+
+If you want to run a specific test:
+
+--------------------------------
+(run! TEST-NAME)
+--------------------------------
+
+Where `TEST-NAME` is either a test object (as returned by `get-test`)
+or a symbol naming a single test or a test suite.
+
+=== Re-running Tests ===
+
+The functions `!`, `!!` and `!!!` rerun recently run tests (we store
+the names passed to run! and simply call run! with those names again).
+
+=== Running Tests at Test Definition Time ===
+
+Often enough, especially when fixing regression bugs, we'll always
+want to run a test right after having changed it. To facilitate this
+set the variable `*run-test-when-defined*` to T and after compiling a
+def-test form we'll call `run!` on the name of the test. For obvious
+reasons you have to set this variable manually after having loaded
+your test suite.
+
+[NOTE]
+Setting `*run-test-when-defined*` will cause `run!` to get called far
+more often than normal. `!` and `!!` and `!!!` don't know that they're
+getting called semi-automatically and will therefore tend to all
+reduce to the same test (which still isn't totally useless behaviour).
+
+=== Debugging failures and errors ===
+
+`*debug-on-error*`::
+
+Normally fiveam will simply capture unexpected errors, record them as
+failures, and move on to the next test (any following checks in the
+test body will not be run). However sometimes, well, all the time
+unless you're running an automated regression test, it's better to not
+capture the error but open up a debugger, set `*debug-on-error*` to
+`T` to get this effect.
+
+`*debug-on-failure*`::
+
+Normally FiveAM will simply record a check failure and move on to the
+next check, however it can be helpful to stop the check and use the
+debugger to see what the state of execution is at the time of the
+test's failure. Setting `*debug-on-failure*` to T will cause FiveAM to
+enter the debugger whenever a test check fails. Exactly what
+information is available is, obviously, implementation dependent.
+
+[[VIEWING_TEST_RESULTS]]
+== Viewing test results ==
+
+FiveAM provides two "explainers", these are classes which, given a set
+of results, produce some human readable/understandable
+output. Explainers are just normal CLOS classes (and can be easily
+subclassed) with one important method: `explain`.
+
+The `run!` and `explain!` functions use the detailed-text-explainer,
+if you want another explainer you'll have to call `run` and `explain`
+yourself:
+
+--------------------------------
+(explain (make-instance MY-EXPLAINER)
+ (run THE-TEST)
+ THE-STREAM)
+--------------------------------
+
+== Random Testing (QuickCheck) ==
+
+TODO.
+
+Every FiveAM test can be a random test, just use the for-all macro.
+
+== Fixtures ==
+
+TODO.
+
+they're macros with names. you can have tests (and suites)
+automatically wrap themeselves in these macros. not much else to say.
+
+[[API_REFERENCE]]
+== API Reference ==
+
+[[OP_DEF-TEST]]
+=== DEF-TEST ===
+
+================================
+--------------------------------
+(def-test NAME
+ (&key DEPENDS-ON SUITE FIXTURE COMPILE-AT PROFILE)
+ &body BODY)
+--------------------------------
+
+include::docstrings/OP_DEF-TEST.txt[]
+================================
+
+[[OP_DEF-SUITE]]
+=== DEF-SUITE ===
+
+================================
+`(def-suite NAME &key DESCRIPTION IN FIXTURE)`
+
+include::docstrings/OP_DEF-SUITE.txt[]
+================================
+
+[[OP_IN-SUITE]]
+[[OP_IN-SUITE-STAR-]]
+=== IN-SUITE / IN-SUITE* ===
+
+================================
+`(in-suite NAME)`
+
+include::docstrings/OP_IN-SUITE.txt[]
+================================
+
+================================
+`(in-suite* NAME &key IN)`
+
+include::docstrings/OP_IN-SUITE-STAR-.txt[]
+================================
+
+[[OP_IS]]
+=== IS ===
+
+================================
+----
+(is (PREDICATE EXPECTED ACTUAL) &rest REASON-ARGS)
+
+(is (PREDICATE ACTUAL) &rest REASON-ARGS)
+----
+
+include::docstrings/OP_IS.txt[]
+================================
+
+[[OP_IS-TRUE]]
+[[OP_IS-FALSE]]
+=== IS-TRUE / IS-FALSE / IS-EVERY ===
+
+================================
+`(is-true CONDITION &rest reason)`
+
+include::docstrings/OP_IS-TRUE.txt[]
+================================
+
+================================
+`(is-false CONDITION &rest reason)`
+
+include::docstrings/OP_IS-FALSE.txt[]
+================================
+
+////////////////////////////////
+//// the actual doc string of talks about functionality i don't want
+//// to publises (since it's just weird). se we use our own here
+////////////////////////////////
+================================
+`(is-every predicate &rest (EXPECTED ACTUAL &rest REASON))`
+
+Designed for those cases where you have a large set of expected/actual
+pairs that must be compared using the same predicate function.
+
+Expands into:
+
+----
+(progn
+ (is (,PREDICATE ,EXPECTED ,ACTUAL) ,@REASON)
+ ...
+----
+
+for each argument.
+================================
+
+[[OP_SIGNALS]]
+[[OP_FINISHES]]
+=== SIGNALS / FINISHES ===
+
+================================
+`(signals CONDITION &body body)`
+
+include::docstrings/OP_SIGNALS.txt[]
+================================
+
+================================
+`(finishes &body body)`
+
+include::docstrings/OP_FINISHES.txt[]
+================================
+
+[[OP_PASS]]
+[[OP_FAIL]]
+[[OP_SKIP]]
+=== PASS / FAIL / SKIP ===
+
+================================
+`(skip &rest REASON-ARGS)`
+
+include::docstrings/OP_SKIP.txt[]
+================================
+
+================================
+`(pass &rest REASON-ARGS)`
+
+include::docstrings/OP_PASS.txt[]
+================================
+
+================================
+`(fail &rest REASON-ARGS)`
+
+include::docstrings/OP_FAIL.txt[]
+================================
+
+[[OP_-EPOINT-]]
+[[OP_-EPOINT--EPOINT-]]
+[[OP_-EPOINT--EPOINT--EPOINT-]]
+
+[[OP_RUN-EPOINT-]]
+[[OP_EXPLAIN-EPOINT-]]
+[[OP_DEBUG-EPOINT-]]
+=== RUN! / EXPLAIN! / DEBUG! ===
+
+================================
+`(run! &optional TEST-NAME)`
+
+include::docstrings/OP_RUN-EPOINT-.txt[]
+================================
+
+================================
+`(explain! RESULT-LIST)`
+
+include::docstrings/OP_EXPLAIN-EPOINT-.txt[]
+================================
+
+================================
+`(debug! TEST-NAME)`
+
+include::docstrings/OP_DEBUG-EPOINT-.txt[]
+================================
+
+[[OP_RUN]]
+=== RUN ===
+
+================================
+`(run TEST-SPEC)`
+
+include::docstrings/OP_RUN.txt[]
+================================
+
+=== ! / !! / !!! ===
+
+================================
+`(!)`
+
+include::docstrings/OP_-EPOINT-.txt[]
+================================
+
+================================
+`(!!)`
+
+include::docstrings/OP_-EPOINT--EPOINT-.txt[]
+================================
+
+================================
+`(!!!)`
+
+include::docstrings/OP_-EPOINT--EPOINT--EPOINT-.txt[]
+================================
+
+[[OP_FOR-ALL]]
+=== FOR-ALL ===
+
+================================
+--------------------------------
+(for-all (&rest (NAME VALUE &optional GUARD))
+ &body body)
+--------------------------------
+
+include::docstrings/OP_FOR-ALL.txt[]
+================================
+
+[[VAR_-STAR-NUM-TRIALS-STAR-]]
+[[VAR_-STAR-MAX-TRIALS-STAR-]]
+=== \*NUM-TRIALS* / \*MAX-TRIALS* ===
+
+================================
+`*num-trials*`
+
+include::docstrings/VAR_-STAR-NUM-TRIALS-STAR-.txt[]
+================================
+
+================================
+`*max-trials*`
+
+include::docstrings/VAR_-STAR-MAX-TRIALS-STAR-.txt[]
+================================
+
+[[OP_GEN-INTEGER]]
+[[OP_GEN-FLOAT]]
+=== GEN-INTEGER / GEN-FLOAT ===
+
+================================
+`(gen-integer &key MIN MAX)`
+
+include::docstrings/OP_GEN-INTEGER.txt[]
+================================
+
+================================
+`(gen-float &key BOUND TYPE MIN MAX)`
+
+include::docstrings/OP_GEN-FLOAT.txt[]
+================================
+
+[[OP_GEN-CHARACTER]]
+[[OP_GEN-STRING]]
+=== GEN-CHARACTER / GEN-STRING ===
+
+================================
+`(gen-character &key CODE-LIMIT CODE ALPHANUMERICP)`
+
+include::docstrings/OP_GEN-CHARACTER.txt[]
+================================
+
+================================
+`(gen-string &key LENGTH ELEMENTS)`
+
+include::docstrings/OP_GEN-STRING.txt[]
+================================
+
+[[OP_GEN-BUFFER]]
+=== GEN-BUFFER ===
+
+================================
+`(gen-buffer &key LENGTH ELEMENTS ELEMENT-TYPE)`
+
+include::docstrings/OP_GEN-STRING.txt[]
+================================
+
+[[OP_GEN-LIST]]
+[[OP_GEN-TREE]]
+=== GEN-LIST / GEN-TREE ===
+
+================================
+`(gen-list &key LENGTH ELEMENTS)`
+
+include::docstrings/OP_GEN-LIST.txt[]
+================================
+
+================================
+`(gen-tree &key SIZE ELEMENTS)`
+
+include::docstrings/OP_GEN-TREE.txt[]
+================================
+
+[[OP_GEN-ONE-ELEMENT]]
+=== GEN-ONE-ELEMENT ===
+
+================================
+`(gen-one-element &rest ELEMENTS)`
+
+include::docstrings/OP_GEN-ONE-ELEMENT.txt[]
+================================
+
+
+
+////////////////////////////////
+
+////////////////////////////////
--- /dev/null
+= FiveAM Tutorial =
+Marco Baringer <mb@bese.it>
+Fall/Winter 2012
+:Author Initials: MB
+:toc:
+:icons:
+:numbered:
+:website: http://common-lisp.net/project/fiveam
+:stylesheet: fiveam.css
+:linkcss:
+
+== Setup ==
+
+Before we even start, we'll need to load FiveAM itself:
+
+--------------------------------
+CL-USER> (quicklisp:quickload :fiveam)
+To load "fiveam":
+ Load 1 ASDF system:
+ fiveam
+; Loading "fiveam"
+
+(:FIVEAM)
+CL-USER> (use-package :5am)
+T
+--------------------------------
+
+== Failure For Beginners ==
+
+Now, this is a tutorial to the testing framework FiveAM. Over the
+course of this tutorial we're going to test an implementation of
+link:https://en.wikipedia.org/wiki/Peano_axioms[peano numbers]
+(basically, pretend that lisp didn't have integers or arithmetic built
+in and we wanted to add it in the least efficent way possible). The
+first thing we need is the constant `0`, a function `zero-p` for
+testing if a number is zero, and function `succ` which, given a number
+`N`, returns its successor (in other words `N + 1`).
+
+It's still not totally clear to me what the `succ` function should
+look like, but the `zero` and `zero-p` functions are easy enough, so
+let's define a test for those two funtions. We'll start by testing
+`zero` as much as we can:
+
+--------------------------------
+(def-test zero ()
+ (finishes (zero)))
+--------------------------------
+
+[NOTE]
+ignore the second argument to def-test for now. if it helps pretend it's filler to make the identation look better.
+
+Since we don't know, nor really care at this stage, what the function
+`zero` returns, we simply use the
+link:manual.html#FUNCTION_FINISHES[`FINISHES`] macro to make sure that
+the function does in fact return (as opposed to signaling some weird
+error). Our `zero-p` test, on the other hand, does actually have
+something we can test. Whatever is returned by `zero` should be
+`zero-p`:
+
+--------------------------------
+(def-test zero-p ()
+ (is-true (zero-p (zero))))
+--------------------------------
+
+Finally, let's run our tests:
+
+--------------------------------
+CL-USER> (run!)
+XXf
+ Did 2 checks.
+ Pass: 0 ( 0%)
+ Skip: 0 ( 0%)
+ Fail: 2 (100%)
+
+ Failure Details:
+ --------------------------------
+ ZERO []:
+ Unexpected Error: #<UNDEFINED-FUNCTION ZERO {10058AD6F3}>
+The function COMMON-LISP-USER::ZERO is undefined..
+ --------------------------------
+ --------------------------------
+ ZERO-P []:
+ Unexpected Error: #<UNDEFINED-FUNCTION ZERO {10056FE5A3}>
+The function COMMON-LISP-USER::ZERO is undefined..
+ --------------------------------
+
+--------------------------------
+
+so, 100% failure rate, and even an Unexpected error...that's bad, but
+it's also what we should have been expecting given that we haven't
+actually defined `zero-p` or `zero`. So, let's define those two
+functions:
+
+--------------------------------
+CL-USER> (defun zero () 'zero)
+ZERO
+CL-USER> (defun zero-p (value) (eql 'zero value))
+ZERO-P
+--------------------------------
+
+Now let's run our test again:
+
+--------------------------------
+CL-USER> (run!)
+..
+ Did 2 checks.
+ Pass: 2 (100%)
+ Skip: 0 ( 0%)
+ Fail: 0 ( 0%)
+--------------------------------
+
+Much better.
+
+[NOTE]
+TEST ALL THE THINGS!
+.
+There's actually a bit of work being done with suites and default
+tests and stuff in order to make that `run!` call do what it just did
+(call our previously defined tests). If you never create a suite on
+your own then you can think of `run!` as being the 'run every test'
+function, if you start creating your own suites (and you will
+eventually), then you'll want to know that run's second, optional,
+argument is the name of a test or suite to run, but until then just go
+with `(run!)`.
+
+== More code ==
+
+So, we have zero, and we can test for zero ness, wouldn't it be nice
+to have the number one too? How about the number two? how about a
+billion? I like the number 1 billion. Now, since we thoroughly read
+through the wiki page on peano numbers we now that there's a function,
+called `succ` which, give one number returns the "next" one. In this
+implementation we're going to represent numbers as nested lists, so
+our `succ` function just wraps its input in another cons cell:
+
+--------------------------------
+(defun succ (number)
+ (cons number nil))
+--------------------------------
+
+Easy enough. That could also be right, it could also be wrong too, we
+don't really have a way to check (yet). We do know one thing though,
+the `succ` of any number (even zero) isn't zero. So let's redefine our
+zero test to check that zero plus one isn't zero:
+
+--------------------------------
+(def-test zero-p ()
+ (is-true (zero-p (zero)))
+ (is-false (zero-p (succ (zero)))))
+--------------------------------
+
+and let's run the test:
+
+--------------------------------
+CL-USER> (run!)
+...
+ Did 3 checks.
+ Pass: 3 (100%)
+ Skip: 0 ( 0%)
+ Fail: 0 ( 0%)
+--------------------------------
+
+Nice!
+
+== Elementary, my dear watson. Run the test. ==
+
+When working interactively like this, we almost always define a
+test and then immediately run it, we can tell fiveam to do that
+automatically by setting `*run-test-when-defined*` to T:
+
+--------------------------------
+CL-USER> (setf *run-test-when-defined* t)
+T
+--------------------------------
+
+Now if we were to redefine (either via the repl as I'm doing here or
+via C-cC-c in a slime buffer), we'll see:
+
+--------------------------------
+CL-USER> (def-test zero-p ()
+ (is-true (zero-p (zero)))
+ (is-false (zero-p (plus-one (zero)))))
+..
+ Did 2 checks.
+ Pass: 2 (100%)
+ Skip: 0 ( 0%)
+ Fail: 0 ( 0%)
+ZERO-P
+--------------------------------
+
+Great, at this point it's time we add a function for testing integer
+equality (in other words, `cl:=`). Let's try with this:
+
+--------------------------------
+CL-USER> (defun equiv (a b)
+ (and (zero-p a) (zero-p b)))
+EQUIV
+--------------------------------
+
+[NOTE]
+Since i'm doing everything in the package common-lisp-user i
+couldn't use the name `=` (or even `equal`). I don't want to talk
+about packages at this point, so we'll just have to live with `equiv`
+for now.
+
+And let's test it:
+
+--------------------------------
+CL-USER> (def-test equiv () (equiv (zero) (zero)))
+ Didn't run anything...huh?
+EQUIV
+--------------------------------
+
+Well, that's not what I was expecting. I'd forgotten that FiveAM,
+unlike other test frameworks, doesn't actually look at the return
+value of the function, it only runs its so called checks (one of which
+is the `is-true` function we've been using so far). So let's add that
+in and try again:
+
+--------------------------------
+CL-USER> (def-test equiv ()
+ (is-true (equiv (zero) (zero))))
+.
+ Did 1 check.
+ Pass: 1 (100%)
+ Skip: 0 ( 0%)
+ Fail: 0 ( 0%)
+
+EQUIV
+--------------------------------
+
+== Failing, but gently. ==
+
+Nice, now, finally, we can test that 1 is equal to 1 (or, in our
+implementation, the successor of zero is equal to the successor of
+zero):
+
+--------------------------------
+CL-USER> (def-test equiv ()
+ (is-true (equiv (zero) (zero)))
+ (is-true (equiv (succ (zero)) (succ (zero)))))
+.f
+ Did 2 checks.
+ Pass: 1 (50%)
+ Skip: 0 ( 0%)
+ Fail: 1 (50%)
+
+ Failure Details:
+ --------------------------------
+ EQUIV []:
+ (EQUIV (SUCC (ZERO)) (SUCC (ZERO))) did not return a true value
+ --------------------------------
+
+EQUIV
+--------------------------------
+
+Oh, cry, baby cry. The important part of that output is this line:
+
+--------------------------------
+ EQUIV []:
+ (EQUIV (SUCC (ZERO)) (SUCC (ZERO))) did not return a true value
+--------------------------------
+
+That means that, in the test `EQUIV` the form `(EQUIV (SUCC (ZERO))
+(SUCC (ZERO)))` evaluated to NIL. I wonder why? It'd be nice to see
+what the values evaluated to, what the actual arguments and return
+value of `EQUIV` was. There are two things we could do at this point:
+
+. Set 5am:*debug-on-failure* to `T` and re-run the test and dig around
+ in the backtrace for the info we need.
+
+. Use the `IS` check macro to get a more informative message in the
+ output.
+
+In practice you'll end up using a combination of both (though i prefer
+that tests run to completion without hitting the debugger, and this
+may have influenced fiveam a bit, but others prefer working with live
+data in a debugger window and that's an equally valid approach).
+
+== Tell me what I need to know ==
+
+However, since this a non-interactive static file, and debuggers are
+really interactive and implementation specific, I'm going to go with
+the second option for now, here's the same test using the `IS` check
+instead of `IS-TRUE`:
+
+--------------------------------
+CL-USER> (def-test equiv ()
+ (is (equiv (zero) (zero)))
+ (is (equiv (succ (zero)) (succ (zero)))))
+.f
+ Did 2 checks.
+ Pass: 1 (50%)
+ Skip: 0 ( 0%)
+ Fail: 1 (50%)
+
+ Failure Details:
+ --------------------------------
+ EQUIV []:
+
+(SUCC (ZERO)) <1>
+
+ evaluated to
+
+(ZERO) <2>
+
+ which is not
+
+EQUIV <3>
+
+ to
+
+(ZERO) <4>
+
+ --------------------------------
+
+EQUIV
+
+<1> actual value's source code
+<2> actual value's value
+<3> comparison operator
+<4> expected value
+--------------------------------
+
+I need to mention something at this point: the `IS-TRUE` and `IS`
+macro do not do anything different at run time. They both have some
+code, which they run, and if the result is NIL they record a failure
+and if not they record a success (which 5am calls a pass). The only
+difference is in how they report a failure: The `IS-TRUE` function
+just stores the source form and prints that back, the `IS` macro
+assumes that the form has a specific format:
+
+ (TEST-FUNCTION EXPECTED-VALUE ACTUAL-VALUE)
+
+and generates a failure message based on that. In this case we
+evaluated `(succ (zero))`, and got `(zero)`, and passed this value,
+along with the result of the expected value (`(succ (zero))`) to
+`equiv` and got `NIL`.
+
+Now, back to our test, it's actually pretty obvious that our current
+implementation of equiv:
+
+--------------------------------
+(defun equiv (a b)
+ (and (zero-p a) (zero-p b)))
+--------------------------------
+
+is buggy, so let's fix and run the test again:
+
+--------------------------------
+CL-USER> (defun equiv (a b)
+ (if (and (zero-p a) (zero-p b))
+ t
+ (equiv (car a) (car b))))
+EQUIV
+CL-USER> (!)
+..
+ Did 2 checks.
+ Pass: 2 (100%)
+ Skip: 0 ( 0%)
+ Fail: 0 ( 0%)
+
+NIL
+--------------------------------
+
+== Again, from the top ==
+
+Great, our tests passed. You'll notice though that this time we used
+the `!` function instead of `run!`.
+
+== Birds of a feather flock together. Horses of a different color stay home. ==
+
+So far we've always defined and run single tests, while it's certainly
+possible to continue this way it gets unweidly pretty quickly.
+
(test-case :accessor test-case :initarg :test-case)
(test-expr :accessor test-expr :initarg :test-expr))
(:documentation "All checking macros will generate an object of
- type TEST-RESULT."))
+type TEST-RESULT."))
(defclass test-passed (test-result)
()
(defun add-result (result-type &rest make-instance-args)
"Create a TEST-RESULT object of type RESULT-TYPE passing it the
- initialize args MAKE-INSTANCE-ARGS and adds the resulting
- object to the list of test results."
+initialize args MAKE-INSTANCE-ARGS and adds the resulting object to
+the list of test results."
(with-run-state (result-list current-test)
(let ((result (apply #'make-instance result-type
(append make-instance-args (list :test-case current-test)))))
otherwise a test-failure result is generated. The reason, unless
REASON-ARGS is provided, is generated based on the form of TEST:
- (predicate expected actual) - Means that we want to check
- whether, according to PREDICATE, the ACTUAL value is
- in fact what we EXPECTED.
+\(predicate expected actual) - Means that we want to check whether,
+according to PREDICATE, the ACTUAL value is in fact what we EXPECTED.
- (predicate value) - Means that we want to ensure that VALUE
- satisfies PREDICATE.
+\(predicate value) - Means that we want to ensure that VALUE satisfies
+PREDICATE.
- Wrapping the TEST form in a NOT simply produces a negated reason
- string."
+Wrapping the TEST form in a NOT simply produces a negated reason
+string."
(assert (listp test)
(test)
"Argument to IS must be a list, not ~S" test)
;;;; *** 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.
;;
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))))
((tests :accessor tests :initform (make-hash-table :test 'eql)
:documentation "The hash table mapping names to test
objects in this suite. The values in this hash table
- can be either test-cases or other test-suites."))
+ can be either test-cases or other test-suites.")
+ (fixture :accessor fixture :initform nil :initarg :fixture
+ :documentation "FIXTURE to use, by default, for tests in
+ this suite."))
(:documentation "A test suite is a collection of tests or test suites.
Test suites serve to organize tests into groups so that the
((test-lambda :initarg :test-lambda :accessor test-lambda
:documentation "The function to run.")
(runtime-package :initarg :runtime-package :accessor runtime-package
- :documentation "By default it stores *package* from the time this test was defined (macroexpanded)."))
+ :documentation "By default it stores *package*
+ from the time this test was
+ defined (macroexpanded)."))
(:documentation "A test case is a single, named, collection of
checks.
(defpackage :it.bese.fiveam
(:use :common-lisp :alexandria)
(:nicknames :5am :fiveam)
+ #+sb-package-locks
+ (:lock t)
(:export
;; creating tests and test-suites
#:make-suite
#:fail
#:*test-dribble*
#:for-all
+ #:*num-trials*
+ #:*max-trials*
#:gen-integer
#:gen-float
#:gen-character
#:*debug-on-error*
#:*debug-on-failure*
#:*verbose-failures*
- #:results-status))
+ #:results-status
+ ;; introspection
+ #:list-all-suites))
;;;; You can use #+5am to put your test-defining code inline with your
;;;; other code - and not require people to have fiveam to run your
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))
(lambda ()
(+ min (random (1+ (- max min))))))
-(defun gen-float (&key bound (type 'short-float))
- "Returns a generator which producs floats of type TYPE. BOUND,
-if specified, constrains the ruselts to be in the range (-BOUND,
-BOUND)."
+(defun type-most-negative (floating-point-type)
+ (ecase floating-point-type
+ (short-float most-negative-short-float)
+ (single-float most-negative-single-float)
+ (double-float most-negative-double-float)
+ (long-float most-negative-long-float)))
+
+(defun type-most-positive (floating-point-type)
+ (ecase floating-point-type
+ (short-float most-positive-short-float)
+ (single-float most-positive-single-float)
+ (double-float most-positive-double-float)
+ (long-float most-positive-long-float)) )
+
+(defun gen-float (&key bound (type 'short-float) min max)
+ "Returns a generator which producs floats of type TYPE.
+
+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 ()
- (let* ((most-negative (ecase type
- (short-float most-negative-short-float)
- (single-float most-negative-single-float)
- (double-float most-negative-double-float)
- (long-float most-negative-long-float)))
- (most-positive (ecase type
- (short-float most-positive-short-float)
- (single-float most-positive-single-float)
- (double-float most-positive-double-float)
- (long-float most-positive-long-float)))
- (bound (or bound (max most-positive (- most-negative)))))
- (coerce
- (ecase (random 2)
- (0 ;; generate a positive number
- (random (min most-positive bound)))
- (1 ;; generate a negative number
- (- (random (min (- most-negative) bound)))))
- type))))
+ (flet ((rand (limit) (random (coerce limit type))))
+ (when (and bound (or min max))
+ (error "GET-FLOAT does not support specifying :BOUND and :MAX/:MIN."))
+ (if (or min max)
+ (handler-bind ((arithmetic-error (lambda (c)
+ (error "ERROR ~S occured when attempting to generate a random value between ~S and ~S." c min max))))
+ (setf min (or min 0)
+ max (or max (type-most-positive type)))
+ (+ min (rand (- max min))))
+ (let ((min (if bound bound (- (type-most-negative type))))
+ (max (if bound bound (type-most-positive type))))
+ (ecase (random 2)
+ (0 ;; generate a positive number
+ (rand max))
+ (1 ;; generate a negative number NB: min is actually
+ ;; positive. see the if statement above.
+ (- (rand min)))))))))
(defun gen-character (&key (code-limit char-code-limit)
(code (gen-integer :min 0 :max (1- code-limit)))
(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)))
(defun results-status (result-list)
"Given a list of test results (generated while running a test)
return true if all of the results are of type TEST-PASSED,
- faile otherwise."
- (every (lambda (res)
- (typep res 'test-passed))
- result-list))
+ fail otherwise.
+ Returns a second value, which is the set of failed tests."
+ (let ((failed-tests
+ (remove-if #'test-passed-p result-list)))
+ (values (null failed-tests)
+ failed-tests)))
(defun return-result-list (test-lambda)
"Run the test function TEST-LAMBDA and return a list of all
(run-tests)
(run-tests)))
(setf suite-results result-list
- (status suite) (every (lambda (res)
- (typep res 'test-passed))
- suite-results)))
+ (status suite) (every #'test-passed-p suite-results)))
(with-run-state (result-list)
(setf result-list (nconc result-list suite-results)))))))
(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*))
;;;; ** Creating Suits
-(defmacro def-suite (name &key description in)
+(defvar *suites* (make-hash-table :test 'eql))
+
+(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
+def-test) to pass to tests in this suite."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(make-suite ',name
,@(when description `(:description ,description))
- ,@(when in `(:in ',in)))
+ ,@(when in-p `(:in ',in))
+ ,@(when fixture-p `(:fixture ',fixture)))
',name))
(defmacro def-suite* (name &rest def-suite-args)
(def-suite ,name ,@def-suite-args)
(in-suite ,name)))
-(defun make-suite (name &key description in)
+(defun remove-from-suites (test-name)
+ (when (get-test test-name)
+ ;; if this suite alruady exists, and its :IN some other suite, remove it.
+ (dolist (s (list-all-suites))
+ (when (gethash test-name (tests s))
+ (remhash test-name (tests s))))))
+
+(defun make-suite (name &key description ((:in parent-suite) *suite*) fixture)
"Create a new test suite object.
Overrides any existing suite named NAME."
- (let ((suite (make-instance 'test-suite :name name)))
+ (remove-from-suites name)
+ (let ((suite (make-instance 'test-suite :name name :fixture fixture)))
(when description
(setf (description suite) description))
- (loop for i in (ensure-list in)
+ (setf (gethash name *suites*) suite)
+ (loop for i in (ensure-list parent-suite)
for in-suite = (get-test i)
do (progn
(when (null in-suite)
(setf (get-test name) suite)
suite))
+(defun list-all-suites ()
+ (loop for suite being the hash-value in *suites*
+ collect suite))
+
;;;; ** Managing the Current Suite
-(defvar *suite* (setf (get-test 'NIL)
- (make-suite 'NIL :description "Global Suite"))
+(defvar *suite* (setf (get-test 'T) (make-suite 'T :description "Default global suite" :in nil))
"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)
- "Just like in-suite, but silently creates missing suites."
- `(%in-suite ,suite-name :in ,in :fail-on-error nil))
+(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
+ :fail-on-error nil
+ ,@def-suite-args))
-(defmacro %in-suite (suite-name &key (fail-on-error t) in)
+(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 :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.")
-
-(defun get-test (key &optional default)
- (gethash key *test* default))
+ "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
+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))
collect test))
(defmacro test (name &body body)
- "Create a test named NAME. If NAME is a list it must be of the
-form:
-
- (name &key depends-on suite fixture compile-at profile)
-
-NAME is the symbol which names the test.
-
-DEPENDS-ON is a list of the form:
-
- (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.
-
- (OR . test-names) - If any of TEST-NAMES has passed this test is
- run, otherwise a test-skipped result is generated.
-
- (NOT test-name) - This is test is run only if TEST-NAME failed.
-
-AND, OR and NOT can be combined to produce complex dependencies.
-
-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.
-
-FIXTURE specifies a fixture to wrap the body in.
-
-If PROFILE is T profiling information will be collected as well."
- (simple-style-warning "~A is OBSOLETE! Use ~A instead."
- 'test 'def-test)
+ "Deprecated. See DEF-TEST."
+ (simple-style-warning "~A is OBSOLETE! Use ~A instead." 'test 'def-test)
(destructuring-bind (name &rest args)
(ensure-list name)
`(def-test ,name (,@args) ,@body)))
-(defmacro def-test (name (&key depends-on (suite '*suite* suite-p) fixture
- (compile-at :run-time) profile)
+(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.
+
+SUITE (a test name)::
+ The suite to put the test under. It defaults to *SUITE* (which
+ itself defaults to the default global suite).
-DEPENDS-ON is a list of the form:
+FIXTURE::
+ The name of the fixture to use for this test. See `WITH-FIXTURE` for
+ details on fixtures.
- (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.
+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.
- (OR . test-names) - If any of TEST-NAMES has passed this test is
- run, otherwise a test-skipped result is generated.
+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).
- (NOT test-name) - This is test is run only if TEST-NAME failed.
+ `(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.
-AND, OR and NOT can be combined to produce complex dependencies.
+ `(or &rest TEST-NAMES)`:::
+ If any of TEST-NAMES has passed this test is run, otherwise a
+ 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.
+ `(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."
+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)
(let* ((description (or docstring ""))
(body-forms (append decls forms))
(suite-form (if suite-p
- `(get-test ',suite)
- (or suite '*suite*)))
- (effective-body (if fixture
- (destructuring-bind (name &rest args)
- (ensure-list fixture)
- `((with-fixture ,name ,args ,@body-forms)))
- body-forms)))
+ (if suite
+ `(get-test ',suite)
+ nil)
+ '*suite*))
+ (effective-body (let* ((test-fixture fixture)
+ (suite-fixture (if suite-p
+ (if suite
+ (fixture (get-test suite :error t))
+ nil)
+ (if *suite*
+ (fixture *suite*)
+ nil)))
+ (effective-fixture (or test-fixture suite-fixture)))
+ (if effective-fixture
+ (destructuring-bind (name &rest args)
+ (ensure-list effective-fixture)
+ `((with-fixture ,name ,args ,@body-forms)))
+ body-forms))))
`(progn
- (register-test ',name ,description ',effective-body ,suite-form ',depends-on ,compile-at ,profile)
+ (register-test :name ',name
+ :description ,description
+ :body ',effective-body
+ :suite ,suite-form
+ :depends-on ',depends-on
+ :compile-at ,compile-at
+ :profile ,profile)
(when *run-test-when-defined*
(run! ',name))
',name))))
-(defun register-test (name description body suite depends-on compile-at profile)
+(defun register-test (&key name description body suite depends-on compile-at profile)
+ (remove-from-suites name)
(let ((lambda-name
(format-symbol t "%~A-~A" '#:test name))
(inner-lambda-name
:description description
:depends-on depends-on
:collect-profiling-info profile))
- (setf (gethash name (tests suite)) name)))
+ (when suite
+ (setf (gethash name (tests (get-test suite :error t))) name))))
(defvar *run-test-when-defined* nil
"When non-NIL tests are run as soon as they are defined.")
(return-from item)))))
(mapcar #'funcall (mapcar #'cdr collectors))))
-;;;; ** Anaphoric conditionals
-
-(defmacro if-bind (var test &body then/else)
- "Anaphoric IF control structure.
-
-VAR (a symbol) will be bound to the primary value of TEST. If
-TEST returns a true value then THEN will be executed, otherwise
-ELSE will be executed."
- (assert (first then/else)
- (then/else)
- "IF-BIND missing THEN clause.")
- (destructuring-bind (then &optional else)
- then/else
- `(let ((,var ,test))
- (if ,var ,then ,else))))
-
-(defmacro aif (test then &optional else)
- "Just like IF-BIND but the var is always IT."
- `(if-bind it ,test ,then ,else))
-
;;;; ** Simple list matching based on code from Paul Graham's On Lisp.
(defmacro acond2 (&rest clauses)
(defun binding (x binds)
(labels ((recbind (x binds)
- (aif (assoc x binds)
- (or (recbind (cdr it) binds)
- it))))
+ (if-let (value (assoc x binds))
+ (or (recbind (cdr value) binds)
+ value))))
(let ((b (recbind x binds)))
(values (cdr b) b))))
(in-suite :it.bese.fiveam)
-(def-suite test-suite :description "Suite for tests which should fail.")
+(def-suite test-suite
+ :description "Suite for tests which should fail."
+ :in nil)
(defmacro with-test-results ((results test-name) &body body)
`(let ((,results (with-*test-dribble* nil (run ',test-name))))
(is (= 1 (length (remove-if-not #'test-failure-p results))))))
(def-test circular-0 (:depends-on (and circular-1 circular-2 or1)
- :suite test-suite)
+ :suite test-suite)
(fail "we depend on a circular dependency, we should not be tested."))
(def-test circular-1 (:depends-on (and circular-2)
- :suite test-suite)
+ :suite test-suite)
(fail "we have a circular depednency, we should not be tested."))
(def-test circular-2 (:depends-on (and circular-1)
- :suite test-suite)
+ :suite test-suite)
(fail "we have a circular depednency, we should not be tested."))
(def-test circular ()
(run 'circular-2)))
-(def-suite before-test-suite :description "Suite for before test")
+(def-suite before-test-suite :description "Suite for before test" :in nil)
(def-test before-0 (:suite before-test-suite)
(pass))
(def-test before-1 (:depends-on (:before before-0)
- :suite before-test-suite)
+ :suite before-test-suite)
(fail))
-(def-suite before-test-suite-2 :description "Suite for before test")
+(def-suite before-test-suite-2 :description "Suite for before test" :in nil)
(def-test before-2 (:depends-on (:before before-3)
- :suite before-test-suite-2)
+ :suite before-test-suite-2)
(pass))
(def-test before-3 (:suite before-test-suite-2)
(test-gen-float single-float)
(test-gen-float short-float)
(test-gen-float double-float)
- (test-gen-float long-float)))
+ (test-gen-float long-float)
+
+ (for-all ((value (gen-float :type 'single-float :min 1 :max 2)))
+ (is (typep value 'single-float))
+ (is (<= (coerce 1 'single-float) value (coerce 2 'single-float))))))
(def-test gen-character ()
(for-all ((c (gen-character)))
(for-all (((a b) (dummy-mv-generator)))
(is (= 1 a))
(is (= 1 b))))
+
+(def-test introspection ()
+ (is (= (length (list-all-suites))
+ (hash-table-count *suites*))))
+
+(defvar *special-variable* nil)
+
+(def-fixture fixture-for-suite (value)
+ (progn
+ (setf *special-variable* value)
+ (&body)))
+
+(def-suite suite-with-fixture :fixture (fixture-for-suite 42) :in :it.bese.fiveam)
+
+(def-test test-with-suite-fixture (:suite suite-with-fixture)
+ (is (= 42 *special-variable*)))
+
+(def-test add-remove-test-from-suite ()
+ (let ((*test* (make-hash-table :test 'eql))
+ (*suites* (make-hash-table :test 'eql)))
+ (in-suite* empty :in nil)
+ (is (null (get-test 'foo)))
+
+ (def-test foo (:suite nil) t)
+ (is-true (get-test 'foo))
+ (is-false (gethash 'foo (tests *suite*)))
+
+ (def-test foo () t)
+ (is-true (gethash 'foo (tests *suite*)))
+
+ (def-test foo (:suite nil) t)
+ (is-false (gethash 'foo (tests *suite*)))))
projects / fiveam.git / commitdiff