Revisiting Guile xUnit
Previously :
- Kick-off
- Chapter 18. First Steps to xUnit
- Chapter 19. Set the Table
- Chapter 20. Cleaning up After
- Chapter 21. Counting
- Chapter 22. Dealing with Failure
- Chapter 23. How Suite It Is
In my last serie about building a testing framework à la xUnit left me with a weird feeling. Following Kent Beck's execution, from the book « Test Driven Development by Example », the exercise of thinking the Scheme way harder than I thought. I ended up with a shaky copy of the Python implementation. So I decided to let time passing by and come back to it to see what I can do differently. In the meantime, I watched a video of Andy Balaam where he showed a small illustration of the idea of Lambda Calculus and how it can be leveraged using a Scheme. That inspired me. Let's see how much, step by step…
All the steps are done by editing a single file so I can go faster evaluating the buffer in Emacs.
I start to write a function which mutates a was-run flag. I check with my own eyes the flag state before and after the function is called.
So I get confident the function does its job.
(define was-run #f)
(if (not was-run) (display "Before OK"))
((lambda () (set! was-run #t)))
(if was-run (display "After OK"))
I name my function test-proc.
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(if (not was-run) (display "Before OK"))
(test-proc)
(if was-run (display "After OK"))
I want to call test-proc from another function named test-run.
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(define (run proc) (proc))
(if (not was-run) (display "Before OK"))
(test-run test-proc)
(if was-run (display "After OK"))
I want to use assert instead of display. So I can let the program telling me if something goes wrong.
(import (rnrs))
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(define (test-run proc) (proc))
(assert (not was-run))
(test-run test-proc)
(assert was-run)
I reorder things to separate the test code and the code under test. So it's now a bit more clear that I want to test drive my own testing framework.
;;;; code under test
(define (test-run proc) (proc))
;;;; test code
(import (rnrs))
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(assert (not was-run))
(test-run test-proc)
(assert was-run)
I put my test in a function (it becomes a test-case) and call test-run on it as well.
;;;; code under test
(define (test-run proc) (proc))
;;;; test code
(import (rnrs))
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(define (test-was-run)
(assert (not was-run))
(test-run test-proc)
(assert was-run))
(test-run test-was-run)
I make two runners for the two use cases.
;;;; code under test
(define (test-runner)
(lambda (proc)
(proc)))
;;;; tests
(import (rnrs))
(define (test-was-run)
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(define test-run (test-runner))
(assert (not was-run))
(test-run test-proc)
(assert was-run))
(define run (test-runner))
(run test-was-run)
I add a test for the setup feature (computation to execute before each test).
;;;; code under test
(define (test-runner)
(lambda (proc)
(proc)))
;;;; tests
(import (rnrs))
(define was-run #f)
(define test-proc (lambda () (set! was-run #t)))
(define test-run (test-runner))
(define (test-was-run)
(assert (not was-run))
(test-run test-proc)
(assert was-run))
(define (test-was-setup)
(assert (not was-setup))
(test-run test-proc)
(assert was-setup))
(define run (test-runner))
(run test-was-run)
(run test-was-setup)
I make the test to pass (+ refactoring)
;;;; code under test
(define (test-runner setup)
(lambda (proc)
(setup)
(proc)))
;;;; tests
(import (rnrs))
(define was-run #f)
(define was-setup #f)
(define (setup-proc) (set! was-run #f) (set! was-setup #t))
(define (test-proc) (set! was-run #t))
(define test-run (test-runner setup-proc))
(define (test-was-run)
(assert (not was-run))
(test-run test-proc)
(assert was-run))
(define (test-was-setup)
(assert (not was-setup))
(test-run test-proc)
(assert was-setup))
(define run (test-runner (lambda () (set! was-setup #f) (set! was-run #f))))
(run test-was-run)
(run test-was-setup)
I refactor to use a log instead of flags (so my two tests are the same, I keep one).
;;;; code under test
(define (test-runner setup)
(lambda (proc)
(setup)
(proc)))
;;;; tests
(import (rnrs))
(define log "")
(define (test-template)
(define (setup-proc) (set! log (string-append log "setup ")))
(define (test-proc) (set! log (string-append log "proc ")))
(define test-run (test-runner setup-proc))
(test-run test-proc)
(assert (string=? "setup proc " log)))
(define run (test-runner (lambda () (set! log ""))))
(run test-template)
I alter the test to handle teardown feature.
;;;; code under test
(define test-runner
(case-lambda
[() (lambda (proc) (proc))]
[(setup) (lambda (proc) (setup) (proc))]
[(setup teardown) (lambda (proc) (setup) (proc) (teardown))]))
;;;; tests
(import (rnrs))
(define (test-template)
(define log "")
(let ([setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define run (test-runner))
(run test-template)
I add a test to print test results
;;;; code under test
(define test-runner
(case-lambda
[() (lambda (proc) (proc))]
[(setup) (lambda (proc) (setup) (proc))]
[(setup teardown) (lambda (proc) (setup) (proc) (teardown))]))
;;;; tests
(import (rnrs))
(define (test-template)
(define log "")
(let ([setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define (test-result)
(define test-run (test-runner))
(define result (test-run (const #f)))
(assert (string=? "1 run, 0 failed" (summary result))))
(define run (test-runner))
(run test-template)
(run test-result)
I make the test to pass (+ refactoring)
;;;; code under test
(define test-runner
(let ([result '(0 0)])
(case-lambda
[() (lambda (proc) (run-and-count proc result))]
[(setup) (lambda (proc) (setup) (run-and-count proc result))]
[(setup teardown) (lambda (proc) (setup) (run-and-count proc result) (teardown))])))
(define (run-and-count proc result)
(proc)
(list (1+ (car result)) 0))
(define (summary result) (format #f "~A run, 0 failed" (car result)))
;;;; tests
(import (rnrs))
(define (test-template)
(define log "")
(let ([setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define (test-result)
(let ([test-proc (const #f)])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 0 failed" (summary result)))))
(define run (test-runner))
(run test-template)
(run test-result)
I add a test to count failed tests.
;;;; code under test
(define test-runner
(let ([result '(0 0)])
(case-lambda
[() (lambda (proc) (run-and-count proc result))]
[(setup) (lambda (proc) (setup) (run-and-count proc result))]
[(setup teardown) (lambda (proc) (setup) (run-and-count proc result) (teardown))])))
(define (run-and-count proc result)
(proc)
(list (1+ (car result)) 0))
(define (summary result) (format #f "~A run, 0 failed" (car result)))
;;;; tests
(import (rnrs))
(define log "")
(define (test-template)
(let ([setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define (test-result)
(let ([test-proc (const #f)])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 0 failed" (summary result)))))
(define (test-failed-result)
(let ([test-proc (lambda () (raise-exception (make-exception)))])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 1 failed" (summary result)))))
(define run (test-runner))
(run test-template)
(run test-result)
(run test-failed-result)
I write code to make the test to pass (+ refactoring).
;;;; code under test
(define test-runner
(case-lambda
[() (test-runner (const #f) (const #f))]
[(setup) (test-runner setup (const #f))]
[(setup teardown)
(lambda (proc)
(dynamic-wind
setup
(lambda ()
(run-and-count proc (list 0 0)))
teardown))]))
(define (run-and-count proc result)
(with-exception-handler
(lambda (e)
(list (1+ (car result)) (1+ (cadr result))))
(lambda ()
(proc)
(list (1+ (car result)) (cadr result)))
#:unwind? #t))
(define (summary result) (format #f "~A run, ~A failed" (car result) (cadr result)))
;;;; tests
(import (rnrs))
(define (test-template)
(let* ([log ""]
[setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define (test-result)
(let ([test-proc (const #f)])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 0 failed" (summary result)))))
(define (test-failed-result)
(let ([test-proc (lambda () (raise-exception (make-exception)))])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 1 failed" (summary result)))))
(define run (test-runner))
(run test-template)
(run test-result)
(run test-failed-result)
I add a test to run a test suite.
;;;; code under test
(define test-runner
(case-lambda
[() (test-runner (const #f) (const #f))]
[(setup) (test-runner setup (const #f))]
[(setup teardown)
(lambda (proc)
(dynamic-wind
setup
(lambda () (run-and-count proc (list 0 0)))
teardown))]))
(define (run-and-count proc result)
(with-exception-handler
(lambda (e) (list (1+ (car result)) (1+ (cadr result))))
(lambda () (proc) (list (1+ (car result)) (cadr result)))
#:unwind? #t))
(define (summary result)
(format #f "~A run, ~A failed" (car result) (cadr result)))
;;;; tests
(import (rnrs))
(import (srfi srfi-1))
(define (test-template)
(let* ([log ""]
[setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define (test-result)
(let ([test-proc (const #f)])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 0 failed" (summary result)))))
(define (test-failed-result)
(let ([test-proc (lambda () (raise-exception (make-exception)))])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 1 failed" (summary result)))))
(define (test-suite)
(let ([test-proc (const #f)]
[test-proc-broken (lambda () (raise-exception (make-exception)))])
(define suite-run (suite-runner (test-runner)))
(define suite (list test-proc test-proc-broken))
(define suite-result (suite-run suite))
(assert (string=? "2 run, 1 failed" (summary suite-result)))))
(define run (test-runner))
(run test-template)
(run test-result)
(run test-failed-result)
(run test-suite)
I write code to make the test to pass (+ refactoring).
;;;; code under test
(define (suite-runner runner)
(lambda (suite)
(apply map + (map (lambda (proc) (runner proc)) suite))))
(define test-runner
(case-lambda
[() (test-runner (const #f) (const #f))]
[(setup) (test-runner setup (const #f))]
[(setup teardown)
(lambda (proc)
(dynamic-wind
setup
(lambda () (run-and-count proc (list 0 0)))
teardown))]))
(define (run-and-count proc result)
(with-exception-handler
(lambda (e) (list (1+ (car result)) (1+ (cadr result))))
(lambda () (proc) (list (1+ (car result)) (cadr result)))
#:unwind? #t))
(define (summary result)
(format #f "~A run, ~A failed" (car result) (cadr result)))
;;;; tests
(import (rnrs))
(import (srfi srfi-1))
(define (test-template)
(let* ([log ""]
[setup-proc (lambda () (set! log (string-append log "setup ")))]
[test-proc (lambda () (set! log (string-append log "proc ")))]
[teardown-proc (lambda () (set! log (string-append log "teardown ")))])
(define test-run (test-runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log))))
(define (test-result)
(let ([test-proc (const #f)])
(define test-run (test-runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 0 failed" (summary result)))))
(define (test-failed-result)
(let ([test-proc-broken (lambda () (raise-exception (make-exception)))])
(define test-run (test-runner))
(define result (test-run test-proc-broken))
(assert (string=? "1 run, 1 failed" (summary result)))))
(define (test-suite)
(let ([test-proc (const #f)]
[test-proc-broken (lambda () (raise-exception (make-exception)))])
(define suite-run (suite-runner (test-runner)))
(define suite (list test-proc test-proc-broken))
(define suite-result (suite-run suite))
(assert (string=? "2 run, 1 failed" (summary suite-result)))))
(define suite-run (suite-runner (test-runner)))
(summary
(suite-run
(list test-template
test-result
test-failed-result
test-suite)))
I want to run a test suite like I run a test case.
;;;; code under test
(define runner
(case-lambda
[() (runner (const #f) (const #f))]
[(setup) (runner setup (const #f))]
[(setup teardown)
(lambda (procs)
(let* ([null-result '(0 0)]
[run (lambda (to-run)
(dynamic-wind
setup
(lambda () (run-and-count to-run null-result))
teardown))])
(if (not (list? procs))
(run procs)
(combine-results
(map (lambda (proc) (run proc)) procs)))))]))
(define (combine-results results)
(apply map + results))
(define (run-and-count proc result)
(with-exception-handler
(lambda (e) (list (1+ (car result)) (1+ (cadr result))))
(lambda () (proc) (list (1+ (car result)) (cadr result)))
#:unwind? #t))
(define (summary result)
(format #f "~A run, ~A failed" (car result) (cadr result)))
;;;; tests
(import (rnrs))
(import (srfi srfi-1))
(define (test-template)
(define log "")
(define setup-proc (lambda () (set! log (string-append log "setup "))))
(define test-proc (lambda () (set! log (string-append log "proc "))))
(define teardown-proc (lambda () (set! log (string-append log "teardown "))))
(define test-run (runner setup-proc teardown-proc))
(test-run test-proc)
(assert (string=? "setup proc teardown " log)))
(define (test-result)
(define test-proc (const #f))
(define test-run (runner))
(define result (test-run test-proc))
(assert (string=? "1 run, 0 failed" (summary result))))
(define (test-failed-result)
(define test-proc-broken (lambda () (raise-exception (make-exception))))
(define test-run (runner))
(define result (test-run test-proc-broken))
(assert (string=? "1 run, 1 failed" (summary result))))
(define (test-suite)
(define test-proc (const #f))
(define test-proc-broken (lambda () (raise-exception (make-exception))))
(define suite-run (runner))
(define suite (list test-proc test-proc-broken))
(define suite-result (suite-run suite))
(assert (string=? "2 run, 1 failed" (summary suite-result))))
(define suite-run (runner))
(summary
(suite-run
(list test-template test-result test-failed-result test-suite)))
The resulting code under test should be put in different modules (runners and results at least).
Maybe I want to split the runner into two runners (suite-runner and test-runner) to avoid the if construct and get simpler procedures.
Anyway. That was fun !
Thank you very much for reading this article!
Don't hesitate to give me your opinion, suggest an idea for improvement, report an error, or ask a question ! I would be so glad to discuss about the topic covered here with you ! You can reach me here.
Don't miss out on the next ones ! Either via RSS or via e-mail !
And more importantly, share this blog and tell your friends it's the best blog in the history of Free Software! No kidding!
#gnu #guile #tdd #book #english
GPG: 036B 4D54 B7B4 D6C8 DA62 2746 700F 5E0C CBB2 E2D1