(import (chicken bitwise))
(import (chicken file))
(import (chicken io))
(import (chicken process))

(define tests-ran 0)
(define tests-passed 0)
(define tests-failed 0)

(define (create-rom prog-text)
  (let* ((tal-path (create-temporary-file ".tal"))
         (rom-path (string-append tal-path ".rom"))
         (asm-cmd (string-append "uxnasm " tal-path " " rom-path ">/dev/null"))
         (port (open-output-file tal-path)))
    (display prog-text port)
    (close-output-port port)
    (system* asm-cmd)
    rom-path))

(define (read-output port)
  (let ((s (read-string #f port)))
    (if (eq? s #!eof) "" s)))

(define (run-rom prog-text emu-args input-text)
  (let*-values (((rom-path) (create-rom prog-text))
                ((args) (cons rom-path emu-args))
                ((c-out c-in c-pid c-err) (process* "./vm" args)))
    (display input-text c-in)
    (close-output-port c-in)
    (let*-values (((out-text) (read-output c-out))
                  ((err-text) (read-output c-err))
                  ((pid ok status) (process-wait c-pid))
                  ((exit-code) (if ok status (- status))))
      (values exit-code out-text err-text))))

(define (it-failed test-name caption got expected)
  (if (equal? got expected) #f
      (begin
        (display test-name)
        (display ": ")
        (display caption)
        (display " failed; got '")
        (display got)
        (display "' but expected '")
        (display expected)
        (display "'\n")
        #t)))

(define (test-rom test-name prog-text emu-args input-text expect-code expect-out expect-err)
  (let-values (((exit-code out-text err-text) (run-rom prog-text emu-args input-text))
               ((ok) (values #t)))
    (if (it-failed test-name "stdout" out-text expect-out) (set! ok #f) '())
    (if (it-failed test-name "stderr" err-text expect-err) (set! ok #f) '())
    (if (it-failed test-name "exit-code" exit-code expect-code) (set! ok #f) '())
    ok))

(define (run-test test-name prog-text emu-args input-text expect-code expect-out expect-err)
  (let ((ok (test-rom test-name prog-text emu-args input-text expect-code expect-out expect-err)))
    (set! tests-ran (+ tests-ran 1))
    (if ok
        (set! tests-passed (+ tests-passed 1))
        (set! tests-failed (+ tests-failed 1)))
    (display (if ok " + " " E "))
    (display test-name)
    (display "\n")))

(define (display-system* cmd)
  (display "$ ")
  (display cmd)
  (display "\n")
  (system* cmd))

(display-system* "csc -o vm vm.scm")

(display "running tests...\n\n")

(run-test "zero exit" "|100 #800f DEO BRK" '() "" 0 "" "")
(run-test "non-zero exit" "|100 #110f DEO BRK" '() "" 17 "" "")
(run-test "echo A to stdout" "|100 #4118 DEO #800f DEO BRK" '() "" 0 "A" "")
(run-test "echo A to stderr" "|100 #4119 DEO #800f DEO BRK" '() "" 0 "" "A")

(display "\nsummary: ran ")
(display tests-ran)
(display " tests\n")

(display "  ")
(display tests-passed)
(display " passed\n")

(display "  ")
(display tests-failed)
(display " failed\n")