(module assert-test mzscheme
(require (lib "list.ss" "srfi" "1")
"test.ss")
(provide assert-tests)
(define (make-failure-test name pred . args)
(make-test-case
name
(assert-exn exn:test:assertion?
(lambda ()
(apply pred args)))))
(define-assertion (good)
#t)
(define-assertion (bad)
(fail-assertion))
(define assert-tests
(make-test-suite
"Assert tests"
(make-test-case "Simple assert-equal? test"
(assert-equal? 1 1))
(make-test-case "Simple assert-eq? test"
(assert-eq? 'a 'a))
(make-test-case "Simple assert-eqv? test"
(assert-eqv? 'a 'a))
(make-test-case "Simple assert test"
(assert string=? "hello" "hello"))
(make-test-case "Simple assert-true test"
(assert-true (eq? 'a 'a)))
(make-test-case "Simple assert-pred test"
(assert-pred null? (list)))
(make-test-case "Simple assert-exn test"
(assert-exn exn:test:assertion?
(lambda ()
(assert = 1 2))))
(make-test-case "Simple assert-not-exn test"
(assert-not-exn
(lambda ()
(assert = 1 1))))
(make-test-case "Defined assertion succeeds"
(good))
(make-test-case "Simple assert-not-false test"
(assert-not-false 3))
(make-test-case "Use of assertion as expression"
(for-each assert-false '(#f #f #f)))
(make-test-case "Use of local assertion as expression"
(let ()
(define-simple-assertion (assert-symbol? x)
(symbol? x))
(for-each assert-symbol? '(a b c))))
(make-failure-test "assert-equal? failure"
assert-equal?* 1 2)
(make-failure-test "assert-eq? failure"
assert-eq?* 'a 'b)
(make-failure-test "assert-eqv? failure"
assert-eqv?* 'a 'b)
(make-failure-test "assert failure"
assert* string=? "hello" "bye")
(make-failure-test "assert-true failure"
assert-true* (eq? 'a 'b))
(make-failure-test "assert-pred failure"
assert-pred* null? (list 1 2 3))
(make-failure-test "assert-exn failure"
assert-exn* exn:test:assertion? (lambda () (assert = 1 1)))
(make-failure-test "assert-exn wrong exception"
assert-exn* exn:fail:contract:arity? (lambda () (+ 1 2)))
(make-failure-test "assert-not-exn"
assert-not-exn* (lambda () (/ 1 0)))
(make-failure-test "fail with message failure"
fail* "With message")
(make-failure-test "fail without message failure"
fail*)
(make-failure-test "Defined assertion fails"
bad*)
(make-failure-test "assert-not-false failure"
assert-not-false* #f)
(make-test-case "assertion-as-expression failure"
(assert-exn exn:test:assertion?
(lambda ()
(for-each assert-false '(#f not-false)))))
(make-test-case
"Assertion allows optional message"
(begin
(assert* = 1 1 "message")
(assert = 1 1 "message")))
(make-test-case
"Assertion macro parameters evaluated once"
(let ((counter 0))
(assert-true (begin (set! counter (add1 counter))
#t))
(assert = counter 1)))
(make-test-case
"Assertion function parameters evaluated once"
(let ((counter 0))
(assert-true* (begin (set! counter (add1 counter))
#t))
(assert = counter 1)))
(make-test-case
"Macro w/ no message, message is a string"
(let ((exn (with-handlers ([exn? (lambda (exn)
exn)])
(assert-true #f))))
(assert-pred string? (exn-message exn))))
(make-test-case
"Function w/ no message, message is a string"
(let ((exn (with-handlers ([exn? (lambda (exn)
exn)])
(assert-true* #f))))
(assert-pred string? (exn-message exn))))
(make-test-case
"with-assertion-info* captures information"
(let ((name (make-assertion-info 'name "name"))
(info (make-assertion-info 'info "info")))
(with-handlers
[(exn:test:assertion?
(lambda (exn)
(let ((stack (exn:test:assertion-stack exn)))
(assert = (length stack) 2)
(let ((actual-name (first stack))
(actual-info (second stack)))
(assert-equal? name actual-name)
(assert-equal? info actual-info)))))]
(with-assertion-info*
(list name info)
(lambda ()
(fail-assertion))))))
(make-test-case
"with-assertion-info captures information"
(with-handlers
[(exn:test:assertion?
(lambda (exn)
(let ((stack (exn:test:assertion-stack exn)))
(assert = (length stack) 2)
(let ((name (first stack))
(info (second stack)))
(assert-eq? (assertion-info-name name) 'name)
(assert string=? (assertion-info-value name) "name")
(assert-eq? (assertion-info-name info) 'info)
(assert string=? (assertion-info-value info) "info")))))]
(with-assertion-info
(('name "name") ('info "info"))
(fail-assertion))))
(make-test-case
"assertion information stack nesting"
(with-handlers
[(exn:test:assertion?
(lambda (exn)
(let ((stack (exn:test:assertion-stack exn)))
(assert = (length stack) 4)
(assert string=?
(assertion-info-value (first stack))
"name2"))))]
(with-assertion-info
(('name "name") ('info "info"))
(with-assertion-info
(('name "name2") ('info "info2"))
(fail-assertion)))))
(make-test-case
"assertion information stack unwinds"
(with-handlers
[(exn:test:assertion?
(lambda (exn)
(let ((stack (exn:test:assertion-stack exn)))
(assert = (length stack) 2)
(let ((name (first stack))
(info (second stack)))
(assert-eq? (assertion-info-name name) 'name)
(assert string=? (assertion-info-value name) "name")
(assert-eq? (assertion-info-name info) 'info)
(assert string=? (assertion-info-value info) "info")))))]
(with-assertion-info
(('name "name") ('info "info"))
(with-assertion-info
(('name "name") ('info "info"))
#t)
(fail-assertion))))
(make-test-case
"assert-exn traps exception"
(with-handlers
((exn?
(lambda (exn) (fail "Received exception"))))
(assert-exn exn:fail:contract:arity?
(lambda () (= 1)))))
(make-test-case
"assert-exn fails if no exception raised"
(with-handlers
((exn:test:assertion?
(lambda (exn) #t))
(exn:fail:contract:arity?
(lambda (exn) (fail "assert-exn didn't fail"))))
(assert-exn exn? (lambda () (= 1 1)))
(= 1)))
))
)