(module test-generator mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8))
           (prefix gen: "generator.ss")
           (lib "list.ss")
           (lib "control.ss")
           (lib "etc.ss"))
  (gen:define-generator (hi-generator)
                        (gen:yield 'hi))
  (gen:define-generator (play k)
                        (gen:yield 'hello)
                        (gen:yield 'world))
  (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))
     (let ([g (gen:make-generator 
               (lambda (yield)
                 (let ([resume-value (yield 1)])
                   (yield resume-value))))])
        "Resumption point"
        (list (g) (g 2))
        '(1 2)))

     (let ([g (gen:make-generator 
               (lambda (yield)
                 (let loop ([i 0])
                 (let ([resume-value (yield i)])
                   (loop (add1 resume-value))))))])
        "Resumption point 2"
        (foldl (lambda (x acc) (cons (g (first acc)) acc))
               (list (g))
               '(x x x x x))
        '(5 4 3 2 1 0)))
      "weird escapes should be caught well"
      (local ((define (foo)
                (let/cc exit
                  (define g (gen:make-generator
                             (lambda (yield)
                               (exit 5))))
        (check-exn exn:fail?
                   (lambda () (foo)))))
     ;; This test is failing.  I'm not sure how to fix it yet.
      "weird escapes should be caught well with escape continuations too"
      (local ((define (foo)
                (let/ec exit
                  (define g (gen:make-generator
                             (lambda (yield)
                               (exit 5))))
        (check-exn exn:fail? (lambda ()
                               (printf "I see: ~a~n" (foo))))))))
  (test/text-ui generator-tests))