whalesong/test-conform-browser.rkt
2011-03-20 22:50:25 -04:00

52 lines
1.6 KiB
Racket

#lang racket
(require "browser-evaluate.rkt"
"package.rkt"
racket/port
racket/runtime-path)
(define-runtime-path runtime.js "runtime.js")
(define evaluate (make-evaluate
(lambda (program op)
(fprintf op "(function () {")
;; The runtime code
(call-with-input-file* runtime.js
(lambda (ip)
(copy-port ip op)))
(newline op)
(fprintf op "var innerInvoke = ")
(package-anonymous program op)
(fprintf op "();\n")
(fprintf op #<<EOF
return (function(succ, fail, params) {
return innerInvoke(MACHINE, succ, fail, params);
});
});
EOF
)
)))
(define-syntax (test stx)
(syntax-case stx ()
[(_ s exp)
(with-syntax ([stx stx])
(syntax/loc #'stx
(begin
(printf "running test...")
(let ([result (evaluate s)])
(let ([output (evaluated-stdout result)])
(unless (string=? output exp)
(printf " error!\n")
(raise-syntax-error #f (format "Expected ~s, got ~s" exp output)
#'stx)))
(printf " ok (~a milliseconds)\n" (evaluated-t result))))))]))
(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))