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 (lib "class.ss")
         
         "test.ss"
         "assert-test.ss"
         "assert-util-test.ss"
         "test-test.ss"
         "graphical-ui.ss"
         "text-ui.ss")

(define ui 'graphical)

(define register
  (case ui
    ([graphical] test/graphical-ui)
    ([text] (lambda (suite bool) (test/text-ui suite)))))

(register
 (make-test-suite "Various tests"
  assert-tests
  assert-util-tests
  test-tests
  ; util-tests
  (make-test-case "A solitary test case"
                  (assert-equal? 'apple (string->symbol "apple")))
  (make-test-suite "An empty test suite")
  (make-test-suite 
   "Problems..."
   (make-test-case "Should be okay"
                   (begin
                     (assert-true (even? 44))
                     (void)))
   (make-test-case "Also okay"
                   (assert-exn void (lambda () (error 'throws "exception"))))
   (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 "Unfine"
                                    (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 "Infinite loop!"
   ;;                  (let ?()(?)))
   
   (make-test-case "Error with interesting backtrace"
                   (let [(foo (+ 3 (/ 1 0)))]
                     foo))
   (make-test-case "Weird"
                   (begin
                     (let [(cms (let/cc k (continuation-marks k)))]
                       (raise (make-exn:user "gotcha" cms)))
                     (void)))
   ;;  (make-test-case "(read)..."
   ;;                  (assert-pred symbol? (read)))
   
   (make-test-case "Raise non-exn-struct"
                   (raise 'not-an-exn))
   ))
 #t)