#lang scheme

(require (planet schematics/schemeunit:3)
         (planet "io.ss" ("dherman" "io.plt" 1 9))
         scheme/string
         (only-in srfi/13/string string-trim-both)
         "../../runtime.ss"
         "../../eval.ss")

(provide check-output check-result run test-ns)

(define test-ns (make-js-namespace))

(define (run . lines)
  (reset-js-namespace! test-ns)
  (eval-script (string-join lines "\n") test-ns))

(define-simple-check (check-output* expected lines)
  (let ([actual (with-output-to-string (apply run lines))])
    (andmap string=?
            expected
            (regexp-split #rx"[\r\n]+" (string-trim-both actual)))))

(define-syntax-rule (check-output expected lines ...)
  (check-output* expected (list lines ...)))

(define /dev/null
  (make-output-port
   'null
   always-evt
   (lambda (s start end non-block? breakable?) (- end start))
   void
   (lambda (special non-block? breakable?) #t)
   (lambda (s start end) (wrap-evt
                          always-evt
                          (lambda (x)
                            (- end start))))
   (lambda (special) always-evt)))

(define-simple-check (check-result* expected lines)
  (let ([actual (parameterize ([current-output-port /dev/null])
                  (apply run lines))])
    (case expected
      [(object) (object? actual)]
      [(array) (array? actual)]
      [else (equal? expected actual)])))

(define-syntax-rule (check-result expected lines ...)
  (check-result* expected (list lines ...)))