Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: e39ab9e3e7
Fetching contributors…

Cannot retrieve contributors at this time

125 lines (101 sloc) 3.902 kb
; Copyright 2010 Andrew Pennebaker under the terms of the MIT X license
; found at http://www.opensource.org/licenses/mit-license.html
;
; Copyright 2004 Darius Bacon
;
; This code goes with the cl-quickcheck test library -- the idea is to
; make it so easy to put together a regression test suite that there's
; no excuse not to. Even without such a suite, you normally check out
; your code interactively at the Lisp prompt; so the idea here is you
; paste a transcript of the successful interactions right into your
; source file and it gets regression-checked automatically from then
; on. (Python's doctest module and E's Updoc follow the same strategy
; -- this is an imitation of them. Not a very good imitation, I'm
; afraid -- for one thing, the syntax is MCL-specific.)
; E's Updoc is designed to check the examples in documentation files,
; so we could hardly call this a Lisp version without that feature as
; well. It has at least two benefits: keeping documentation from
; going stale, and more subtly to help prevent tests from becoming
; weaker over time as harried programmers fix them to keep passing
; after changes to the code, because the tests are in the
; documentation and you need to keep the examples in your docs up to
; date for your customers anyway (he said naively).
; The syntax in doc files is kind of unfortunate: we still need #{}
; wrapping like the corresponding read macro in Lisp files.
; We ought to try doing something about testing examples from doc
; strings -- does anyone put many examples there?
; I'll bet it'd help if, on test failure, your IDE could give you the
; option of updating the test to follow the newer results. (Instead
; of manually editing them.)
(in-package :cl-quickcheck)
(export '(test-doc-file test-doc-stream doc-test))
(defun test-doc-file (filename)
"Scan a documentation file for embedded #{} test cases and test them."
(with-open-file (stream filename)
(test-doc-stream stream)))
(defun test-doc-stream (stream)
(eval `(progn ,@(parse-doc-stream stream))))
(defmacro doc-test (expr &rest expectation)
`(run-tester '(doc-test ,expr ,@expectation)
(lambda ()
(equal ',expectation (multiple-value-list ,expr)))))
(defun parse-doc-stream (stream)
(let ((c (read-char stream nil nil)))
(cond ((not c) '())
((and (char= c #\#)
(char= (peek-char t stream nil nil) #\{))
(read-char stream)
(cons (updoc-stream stream)
(parse-doc-stream stream)))
(t (parse-doc-stream stream)))))
(set-dispatch-macro-character #\# #\{ (lambda (stream c wtf)
(declare (ignore c wtf))
(updoc-stream stream)))
(defun updoc-stream (stream)
(let ((cases '()))
(loop
(multiple-value-bind (input expectation) (read-test-case stream)
(if input
(push `(doc-test ,input ,@expectation) cases)
(return `(progn ,@(reverse cases))))))))
(defun read-test-case (stream)
(and (read-prompt stream)
(values (read stream) (read-expectation stream))))
(defun read-prompt (stream)
(let ((c (read stream nil nil)))
(cond ((member c '(nil })) nil)
((eq c '?) t)
(t (error "Expected a '?' prompt")))))
(defun read-expectation (stream)
"Return a list of s-expressions read from STREAM up to the next
occurrence of ?, }, or eof."
(if (member (peek-char t stream nil nil) '(#\? #\} nil))
'()
(cons (read stream)
(read-expectation stream))))
; Self test
(defun example-test ()
#{
? (+ 2 3)
5
? (truncate 27 5)
5
2
})
(when *testing*
(example-test)
(test-doc-stream (make-string-input-stream "
This is some sample documentation text to check.
Here are some inline tests:
#{
? (append '(a b c) '(x y z))
(A B C X Y Z)
? (length '(a b c))
3
}
And more tests:
#{
? (not nil)
T
}
")))
Jump to Line
Something went wrong with that request. Please try again.