(require "test.ss"
"all-schemeunit-tests.ss"
"graphical-ui.ss"
"text-ui.ss")
(define ui 'graphical)
(define test/chosen-ui
(case ui
([graphical] test/graphical-ui)
([text] test/text-ui)))
(test/chosen-ui
(make-test-suite "Various tests"
all-schemeunit-tests
(make-test-case "A solitary test case"
(assert-equal? 'apple (string->symbol "apple")))
(make-test-suite "An empty test suite")
(make-test-suite "All of these should be red"
(make-test-case "This case should fail"
(begin
(+ 47
(if (zero? 2)
(* 8 9)
(assert-equal? 4 5)))
(void)))
(make-test-case "Another failure, on a primitive function"
(assert-pred positive? (* 13 -1)))
(make-test-case "Doesn't work, either"
(assert = 1 2))
(make-test-case "Failure of anonymous predicate"
(assert-pred
(lambda (x) #f)
4))
(make-test-case "This causes error"
(cons 4))
(make-test-suite "A nested suite"
(make-test-case "Fine"
(and (assert-equal? 4 (sub1 5))
(assert-eq? 'hi 'hi)))
(make-test-case "Not fine"
(assert-exn (lambda _ #f)
(lambda () (error 'test "look over there!"))))
(make-test-case "Subtle (error)"
(assert-exn
(lambda _ #f)
(error 'test "I'm evaluated *before* assert-exn is applied")))
(make-test-case "Flat fail" (fail)))
(make-test-case "Another error (causes output)"
(begin
(printf "Here's some output")
(fprintf (current-error-port) "talking to error port")
(printf " which will probably be interleaved and all")
(fprintf (current-error-port)
"(but at least it should be marked properly).")
(error 'whoa "made a mistake")))
(make-test-case "Error with interesting backtrace"
(let [(foo (+ 3 (/ 1 0)))]
foo))
(make-test-case "Weird"
(begin
(let [(cms (current-continuation-marks))]
(raise (make-exn "gotcha" cms)))
(void)))
(make-test-case "Raise non-exn-struct"
(raise 'not-an-exn))
)))