(module test-generator mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
           (prefix gen: "generator.ss"))

  (gen:define-generator (hi-generator)
    (gen:yield 'hi))
  (define generator-tests
     "my generator tests"

      "test simple generator with no args"
      (gen:generator-next (hi-generator))
      "generator? on an obvious generator"
      (gen:generator? (gen:list/gen '(hello))))
      "generator? on something that isn't."
      (gen:generator? (lambda () 1)))
     ;; note: the next text here may fail in v301 --- there's a
     ;; bug in mzlib's contract that causes case-lambda contracts
     ;; to have the wrong structure supertype.
     ;; I think this should be fixed in svn.
      "making sure contracts are doing the right thing"
      (lambda ()
        (gen:generator-next (lambda () 42))))
      "empty generator"
      (lambda ()
        (let ([generator (gen:make-generator (lambda (yield) 'ok))])
          (gen:generator-next generator))))
      "check exception handling follows expected flow"
      (let ([f (gen:list/gen '(1 2))])
         (with-handlers ((exn:fail? (lambda (exn) 'oh)))
         (with-handlers ((exn:fail? (lambda (exn) 'no)))
         (with-handlers ((exn:fail? (lambda (exn) 'boo)))
         (with-handlers ((exn:fail? (lambda (exn) 'hoo)))
      "check exception in generator"
      (let ((generator
              (lambda (yield)
                (yield 42)
                (yield (/ 1 0))))))
        (format "~a~a"
                    ([exn:fail? (lambda (exn) 'ok)])
      "list->flattened/gen and generator-fold"
       (gen:generator-fold (lambda (x acc) (cons x acc)) '()
                            '(hello (world ((()()) ((this))) is a test)))))
      '(hello world this is a test))
      (let ([op (open-output-string)])
         (lambda (x) (display x op))
         (gen:make-generator (lambda (yield) (yield 3) (yield 1) (yield 4))))
        (get-output-string op))
      (let ([gen (gen:list/gen '(hello))])
        (list (gen:generator-next gen (lambda (exn) 'foo))
              (gen:generator-next gen (lambda (exn) 'world))))
      '(hello world))))
  (test/text-ui generator-tests))