skwiki-clean — Code review for cleanliness

Re: [Skwiki-clean] Lazy testing

[Darius B. <da...@ac...>]

Updoc is designed to check the examples in documentation files, so we
could hardly call this a Lisp version of it without that feature.
This has at least two benefits: we keep documentation from going
stale, and more subtly we help keep 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 docs up to date for your customers (he said naively).

The syntax here is kind of unfortunate: we still need the #{} like the
corresponding read macro in Lisp files.


(in-package :qc)

(defun check-doc (filename)
  "Scan a documentation file for embedded #{} test cases, and check them."
  (with-open-file (stream filename)
    (check-doc-stream stream)))

(defun check-doc-stream (stream)
  (report (eval `(tests ,@(parse-doc-stream stream)))))

(defun parse-doc-stream (stream)
  (let ((c (read-char stream nil nil)))
    (cond ((not c) '())
          ((char= c #\#)
           (cond ((char= (peek-char t stream nil nil) #\{)
                  (read-char stream)
                  (cons (updoc-stream stream)
                        (parse-doc-stream stream)))
                 (t (parse-doc-stream stream))))
          (t (parse-doc-stream stream)))))


(defmacro doc-test (expr &rest expectation)
  `(run-tester '(doc-test ,expr ,@expectation)
               (lambda () 
                 (equal ',expectation (multiple-value-list ,expr)))))


(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 `(tests ,@(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))))

(defun example-test ()
  #{
? (+ 2 3)
5
? (truncate 27 5)
5
2
  })

(terpri) (report (example-test))
(terpri) (check-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
}
"))

Re: [Skwiki-clean] Common Lisp unit testing

[Darius B. <da...@ac...>]

I'm talking to myself here, but I might as well post the changes:

; A simple library for test-driven development -- see the self-tests at
; the bottom for an example of how to use it.
; TODO:
;  quickcheck
;  keep source-location info somehow?
;  record all results by adding to a global variable?
;   (uglier but easier to get started with without understanding)
;  hierarchical test names?
;  better naming?  i'm not very happy about some of the exported names.

(defpackage :qc
  (:export :test :is :isnt :is= :isnt= :tests
           :report
           :*debug* :*loud*
           :test-name :test-failed :test-detail))
(in-package :qc)


; Test constructors

(defmacro test (flag)
  `(run-tester '(test ,flag) (lambda () ,flag)))

(defmacro is (fn &rest operands)
  (is-macro `(is ,fn ,@operands) `#',fn operands))

(defmacro isnt (fn &rest operands)
  (is-macro `(isnt ,fn ,@operands) `(complement #',fn) operands))

(defmacro is= (&rest operands)
  (is-macro `(is= ,@operands) '#'equal operands))

(defmacro isnt= (&rest operands)
  (is-macro `(isnt= ,@operands) '(complement #'equal) operands))

(defun is-macro (form fn operands)
  `(run-is-tester ',form ,fn (lambda () (list ,@operands))))

(defun tests (&rest tests)
  "Return a compound test outcome made out of a list of outcomes."
  tests)


; Performing the tests

(defvar *debug* nil
  "When true, test failures jump us immediately into the debugger.")

(defstruct test 
  name    ; What test was run.
  failed  ; NIL if passed, T if failed, or a condition if an error occurred.
  detail) ; Function of no args to write more info to stdout.

(defmacro capture-stdout (&body body)
  `(with-output-to-string (*standard-output*)
     ,@body))

(defun remember (name failed &optional (detail (lambda () t)))
  "Make a test outcome, with appropriate interactive side effects."
  (when (and failed *debug*)
    (error "Test failed: ~S~a" name (capture-stdout (funcall detail))))
  (show-progress failed)
  (make-test :name name :failed failed :detail detail))

(defun run-tester (name passp-fn)
  "Return a test outcome from calling PASSP-FN."
  (remember name (call-tester passp-fn)))

(defun call-tester (passp-fn)
  "Call PASSP-FN and return whether it failed."
  (multiple-value-bind (passed condition)
                       (intercept-errors passp-fn)
    (or condition (not passed))))

(defun run-is-tester (name passp-fn arguments-fn)
  "Return a test outcome from applying PASSP-FN to the result of ARGUMENTS-FN."
  (multiple-value-bind (arguments condition)
                       (intercept-errors arguments-fn)
    (if condition
        (remember name condition)
        (remember name 
                  (call-tester (lambda () (apply passp-fn arguments)))
                  (lambda ()
                    (format t "~%  with values~{ ~S~}" arguments))))))

(defun intercept-errors (fn)
  (if *debug*
      (prog1 (funcall fn))
      (ignore-errors (prog1 (funcall fn)))))


; Reporting results

(defvar *loud* t
  "When true, we show progress as tests are run with dots to stdout.")

(defun show-progress (failed)
  "Write a single character as a bird's-eye view of a test result."
  (when *loud*
    (write-char (cond ((not failed) #\.)
                      ((eq t failed) #\X)
                      (t #\@)))))

(defun report (test)
  "Print out the interesting test results in longer form."
  (let ((tests (flatten test)))
    (mapc #'print-test (remove-if-not #'test-failed tests))
    (summarize tests)))

(defun flatten (test)
  "Reduce a possibly compound test to a list of test structs."
  (if (listp test)
      (mapcan #'flatten test)
      (list test)))

(defun print-test (test)
  (let ((failed (test-failed test)))
    (format t "~%~a ~S" (classify failed) (test-name test))
    (when (eq 'error (classify failed))
      (format t "~%  ~a" failed))
    (funcall (test-detail test))))

(defun classify (failed)
  (cond ((not failed) 'pass)
        ((eq t failed) 'fail)
        (t 'error)))

(defun summarize (tests)
  (let ((num-failed (count-if #'test-failed tests))
        (total (length tests)))
    (cond ((= 0 total)
           (format t "~%No tests attempted."))
          ((= 0 num-failed)
           (format t "~%All tests passed: ~a total." total))
          (t 
           (format t "~%~a test~p failed out of ~a total."
                   num-failed num-failed total)))))


; Self tests

(defmacro quietly (&body body)
  `(let ((*loud* nil))
     ,@body))

(defun self-test ()
  (tests
   (is= "." (capture-stdout (test t)))
   (is= "X" (capture-stdout (test nil)))
   (is= "@" (capture-stdout (test (/ 1 0))))
   (is= "@" (capture-stdout (is= 3 (/ 1 0))))
   (is= nil (test-failed (quietly (test t))))
   (is= t   (test-failed (quietly (test nil))))
   
   (is= "
No tests attempted."
        (capture-stdout (report (tests))))
   (is= "..
All tests passed: 2 total."
        (capture-stdout (report (tests (test t) (test t)))))
   (is= "X.
FAIL (TEST NIL)
1 test failed out of 2 total."
        (capture-stdout (report (tests (test nil) (test t)))))

   (is= "X
FAIL (IS = (+ 2 3) 4)
  with values 5 4
1 test failed out of 1 total."
        (capture-stdout (report (is = (+ 2 3) 4))))
   ))

(terpri) (report (self-test))

[Skwiki-clean] Lazy testing

[Darius B. <da...@ac...>]

This code goes with the preceding 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 tests right into your source file and it
gets regression-checked automatically from then on.  (Tim Peters's
test module for Python and E's UpDoc follow that strategy -- this is
an imitation of them.)

Not a very good imitation, I'm afraid -- for one thing, the syntax is
MCL-specific.  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.)

Anyway:


(defmacro doc-test (expr &rest expectation)
  `(run-tester '(doc-test ,expr ,@expectation)
               (lambda () 
                 (equal ',expectation (multiple-value-list ,expr)))))

(defun read-updoc-tests (stream c wtf)
  (declare (ignore c wtf))
  (updoc-stream stream))

(set-dispatch-macro-character #\# #\{ #'read-updoc-tests)

(defun updoc-stream (stream)
  (let ((tests '()))
    (loop
     (multiple-value-bind (input expectation) (read-test-case stream)
       (if input
           (push `(doc-test ,input ,@expectation) tests)
         (return `(tests ,@(reverse tests))))))))

(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))))

(defun example-test ()
  #{
? (+ 2 3)
5
? (truncate 27 5)
5
2
}
)

(terpri) (report (example-test))

[Skwiki-clean] Common Lisp unit testing

[Darius B. <da...@ac...>]

; A simple library for test-driven development -- see the self-tests at
; the bottom for an example of how to use it.
; TODO: 
;  wrap in a package
;  add an option to go straight into the debugger
;  quickcheck
;  keep source-location info somehow?
;  record all results by adding to a global variable?
;   (uglier but easier to get started with without understanding)
;  hierarchical test names?


; Test constructors

(defmacro test (flag)
  `(run-tester '(test ,flag) (lambda () ,flag)))

(defmacro is (fn &rest operands)
  `(run-is-tester '(is ,fn ,@operands)
                  #',fn
                  (lambda () (list ,@operands))))

(defmacro isnt (fn &rest operands)
  `(run-is-tester '(isnt ,fn ,@operands)
                  (complement #',fn)
                  (lambda () (list ,@operands))))

(defun tests (&rest tests)
  "Return a compound test outcome made out of a list of outcomes."
  tests)


; Performing the tests

(defstruct test 
  name    ; What test was run.
  failed  ; NIL if passed, T if failed, or a condition if an error occurred.
  detail) ; Function of no args to write more info to stdout.

(defun remember (name failed &optional (detail (lambda () t)))
  (show-progress failed)
  (make-test :name name :failed failed :detail detail))

(defun run-tester (name passp-fn)
  "Return a test outcome from calling PASSP-FN."
  (remember name (call-tester passp-fn)))

(defun call-tester (passp-fn)
  "Call PASSP-FN and return whether it failed."
  (multiple-value-bind (passed condition)
                       (ignore-errors (prog1 (funcall passp-fn)))
    (or condition (not passed))))

(defun run-is-tester (name passp-fn arguments-fn)
  "Return a test outcome from applying PASSP-FN to the result of ARGUMENTS-FN."
  (multiple-value-bind (arguments condition)
                       (ignore-errors (prog1 (funcall arguments-fn)))
    (if condition
        (remember name condition)
        (let ((failed (call-tester (lambda () (apply passp-fn arguments)))))
          (remember name failed 
                    (lambda ()
                      (format t "~%  with values~{ ~S~}" arguments)))))))


; Reporting results

(defvar *show-progress-p* t
  "When true, we show progress as tests are run with dots to stdout.")

(defun show-progress (failed)
  "Write a single character as a bird's-eye view of a test result."
  (when *show-progress-p*
    (write-char (cond ((not failed) #\.)
                      ((eq t failed) #\X)
                      (t #\@)))))

(defun report (test)
  "Print out the interesting test results in longer form."
  (let ((tests (flatten test)))
    (mapc #'print-test (interesting tests))
    (summarize tests)))

(defun flatten (test)
  "Reduce a possibly compound test to a list of test structs."
  (if (listp test)
      (mapcan #'flatten test)
      (list test)))

(defun summarize (tests)
  (let ((num-failed (count-if #'test-failed tests))
        (total (length tests)))
    (cond ((= 0 total)
           (format t "~%No tests attempted."))
          ((= 0 num-failed)
           (format t "~%All tests passed: ~a total." total))
          (t 
           (format t "~%~a test~p failed out of ~a total."
                   num-failed num-failed total)))))

(defun interesting (tests)
  (remove-if-not #'test-failed tests))

(defun print-test (test)
  (let ((failed (test-failed test)))
    (format t "~%~a ~S" (classify failed) (test-name test))
    (when (eq 'error (classify failed))
      (format t "~%  ~a" failed))
    (funcall (test-detail test))))

(defun classify (failed)
  (cond ((not failed) 'pass)
        ((eq t failed) 'fail)
        (t 'error)))


; Self tests

(defmacro capture-stdout (&body body)
  `(with-output-to-string (*standard-output*)
     ,@body))

(defmacro sans-display (&body body)
  `(let ((*show-progress-p* nil))
     ,@body))

(defun self-test ()
  (tests
   (is equal "." (capture-stdout (test t)))
   (is equal "X" (capture-stdout (test nil)))
   (is equal "@" (capture-stdout (test (/ 1 0))))
   (is equal "@" (capture-stdout (is = 3 (/ 1 0))))
   (is equal nil (test-failed (sans-display (test t))))
   (is equal t   (test-failed (sans-display (test nil))))
   
   (is equal "
No tests attempted."
                (capture-stdout (report (tests))))
   (is equal "..
All tests passed: 2 total."
                (capture-stdout (report (tests (test t) (test t)))))
   (is equal "X.
FAIL (TEST NIL)
1 test failed out of 2 total."
                (capture-stdout (report (tests (test nil) (test t)))))

   (is equal "X
FAIL (IS = (+ 2 3) 4)
  with values 5 4
1 test failed out of 1 total."
                (capture-stdout (report (is = (+ 2 3) 4))))
   ))

(terpri)
(report (self-test))

[Skwiki-clean] Run-length code in Haskell

[Darius B. <da...@ac...>]

Kicking this off with something simple -- I translated the run-length
coder from Kernighan & Plauger's _Software Tools_ to Haskell (a
language I have little experience in), and I have mixed feelings about
the result:

encode :: [Char] -> [Char]
encode cs = coding [] cs

coding buf []     = flush buf []
coding buf (c:cs) = findRun buf c cs 1

findRun buf c (d:cs) nrep | d == c && nrep < 255 = findRun buf c cs (nrep + 1)
findRun buf c cs nrep | nrep < 5  = append buf nrep c cs
                      | otherwise = flush buf ('\0' : c : chr nrep : encode cs)

append buf 0 _ cs = coding buf cs
append buf n c cs = more (n - 1) (buf ++ [c])
  where more n' buf' | length buf' < 255 = append buf' n' c cs
                     | otherwise         = flush buf' (append [] n' c cs)

flush []  rest = rest
flush buf rest = chr (length buf) : buf ++ rest


decode :: [Char] -> [Char]
-- Decode a run-length-encoded string.
decode []            = []
decode ('\0':c:n:cs) = replicate (ord n) c ++ decode cs
decode (n:cs)        = x ++ decode y where (x, y) = splitAt (ord n) cs


It's shorter than K&P's, but has some ugly inefficiencies (like buf++[c]).
Maybe this ought to use a state monad and imitate K&P's imperative code?

Darius