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

  (gen:define-generator (hi-generator)
    (gen:yield 'hi))
  
  (gen:define-generator (play k)
    (gen:yield 'hello)
    (gen:yield 'world))
  
  
  (define generator-tests
    (test-suite
     "my generator tests"
     
     (test-equal?
      "test simple generator with no args"
      (gen:generator-next (hi-generator))
      'hi)
     
     (test-true 
      "generator? on an obvious generator"
      (gen:generator? (gen:list/gen '(hello))))
     
     (test-false
      "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.
     (test-exn
      "making sure contracts are doing the right thing"
      exn:fail:contract?
      (lambda ()
        (gen:generator-next (lambda () 42))))
     
     
     (test-exn
      "empty generator"
      gen:exn:fail:generator-exhausted?
      (lambda ()
        (let ([generator (gen:make-generator (lambda (yield) 'ok))])
          (gen:generator-next generator))))
     
     
     (test-equal? 
      "check exception handling follows expected flow"
      (let ([f (gen:list/gen '(1 2))])
        (format
         "~a~a~a~a"
         (with-handlers ((exn:fail? (lambda (exn) 'oh)))
           (f))
         (with-handlers ((exn:fail? (lambda (exn) 'no)))
           (f))
         (with-handlers ((exn:fail? (lambda (exn) 'boo)))
           (f))
         (with-handlers ((exn:fail? (lambda (exn) 'hoo)))
           (f))))
      "12boohoo")
     
     
     (test-equal?
      "check exception in generator"
      (let ((generator
             (gen:make-generator 
              (lambda (yield)
                (yield 42)
                (yield (/ 1 0))))))
        (format "~a~a"
                (generator)
                (with-handlers 
                    ([exn:fail? (lambda (exn) 'ok)])
                  (generator))))
      "42ok")
     
     
     (test-equal?
      "list->flattened/gen and generator-fold"
      (reverse 
       (gen:generator-fold (lambda (x acc) (cons x acc)) '()
                           (gen:list->flattened/gen 
                            '(hello (world ((()()) ((this))) is a test)))))
      '(hello world this is a test))
     
     
     (test-equal?
      "generator-for-each"
      (let ([op (open-output-string)])
        (gen:generator-for-each 
         (lambda (x) (display x op))
         (gen:make-generator (lambda (yield) (yield 3) (yield 1) (yield 4))))
        (get-output-string op))
      "314")
     
     
     (test-equal?
      "generator-next"
      (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))))])
       (test-equal? 
        "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))))))])
       (test-equal? 
        "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)))
                       
     
     ))
  
  
  (test/text-ui generator-tests))