Crafting happiness with Free Software & Hardware

Revisiting Guile xUnit

Guile Logo

Previously :

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