Testing framework for Racket

testing.rkt

;;;
;
; Testing framework for Racket
;
; Being very minimalistic this framework was designed to be as easy to learn as possible
; and to be just enough for those taking the “Programming Languages” course at Coursera
; [https://class.coursera.org/proglang-2012-001/].
;
; https://gist.github.com/4988539
;
; -- Kirill Elagin <[email protected]>
;;;

#lang racket


(define-syntax-rule (expr-to-str e)
  (format "~s" (syntax->datum #'e)))

(define-syntax t
  (syntax-rules (IS)
    [(_ e msg) (if e #t (begin (displayln (string-append "! FAIL: " msg)) #f))]
    [(_ e) (t e (expr-to-str e))]
    [(_ e IS v) (let ([res e] [ans v])
                      (t (equal? res ans) (string-append (expr-to-str e) " IS " (format "~v" res) " MUST BE " (format "~v" ans))))]))

(define (run-tests tests)
  (let [(failed (count not tests))]
    (begin
      (printf "--~nTotal tests run: ~v~n" (length tests))
      (if (= failed 0)
          (printf "All tests passed!")
          (printf "Tests failed: ~v" failed)))))

(define-syntax-rule (raises pred e)
  (let ([res (with-handlers ([pred (lambda (exn) (cons #t #f))]
                             [(lambda (exn) #t) (lambda (exn) (cons #t exn))])
               (cons #f e))])
    (cond
      [(and (car res) (not (cdr res))) #t]
      [(car res) (begin (displayln (format "! FAIL: ~a raised WRONG exception ~v, predicate WAS: ~a" (expr-to-str e) (cdr res) (expr-to-str pred))) #f)]
      [#t (begin (displayln (format "! FAIL: ~a returned ~v instead of raising an exception, predicate WAS: ~a" (expr-to-str e) (cdr res) (expr-to-str pred))) #f)])))

(define-syntax-rule (errors msg e)
  (let ([error-with-msg? (lambda (m) (lambda (exn) (and (exn:fail? exn) (equal? m (exn-message exn)))))])
    (raises (error-with-msg? msg) e)))



;;;;
;; Sample usage
;; (yes, you can simply run this file)

(run-tests (list
 (t (> 5 2)) ; OK
 (t (+ 1 4) IS 5) ; OK
 (t (+ 1 6) IS -100) ; will fail
 (t (> 1 3)) ; will fail
 (t (filter odd? (list 1 3 4)) IS (list 1 3 5)) ; will fail

 ;this lets you make sure your function
 ;raises exceptions when appropriate
 (raises exn:fail? (error "hi")) ; OK
 (raises exn:break? (error "hi")) ; wrong exception
 (raises exn:fail? (+ 1 6)) ; doesn't raise

 ;check that function calls `(error ...)` with
 ;the right string
 (errors "hi" (error "hi")) ; OK
 (errors "hi" (error "bla")) ; calls `error` with wrong string
 (errors "hi" (+ 1 2)) ; doesn't raise
))

;;;;
;; This will output:

;! FAIL: (+ 1 6) IS 7 MUST BE -100
;! FAIL: (> 1 3)
;! FAIL: (filter odd? (list 1 3 4)) IS '(1 3) MUST BE '(1 3 5)
;! FAIL: (error "hi") raised WRONG exception (exn:fail "hi" #<continuation-mark-set>), predicate WAS: exn:break?
;! FAIL: (+ 1 6) returned 7 instead of raising an exception, predicate WAS: exn:fail?
;! FAIL: (error "bla") raised WRONG exception (exn:fail "bla" #<continuation-mark-set>), predicate WAS: (error-with-msg? "hi")
;! FAIL: (+ 1 2) returned 3 instead of raising an exception, predicate WAS: (error-with-msg? "hi")
;--
;Total tests run: 11
;Tests failed: 7