demo-interfaces.ss
;; demo-interfaces
;; Demonstrates the use of the various user interfaces for SchemeUnit.
;; Define ui to be one of 'graphical, or 'text to use that
;; user interface. For the text and graphical UIs, run the tests by clicking
;; the Execute button.

(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))
     )))