suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjusted the test system to use just one browser window instance instead of several, but I'm still running into the browser crash. Ugh.

Browse Source
This commit is contained in:
Danny Yoo 2011-06-06 11:34:01 -04:00
parent c92f018aa8
commit bd2487a051
1 changed files with 148 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

245
tests/browser-evaluate.rkt
View File

@ -25,137 +25,130 @@
;; make-evaluate: (Any output-port) -> void
;; Produce a JavaScript evaluator that cooperates with a browser. (define ch
;; The JavaScript-compiler is expected to write out a thunk. When invoked, (let ()
;; the thunk should return a function that consumes three values, corresponding (define port (+ 8000 (random 8000)))
;; to success, failure, and other parameters to evaluation. For example: ;; This channel's meant to serialize use of the web server.
;; (define ch (make-channel))
;; (make-evaluate (lambda (program op)
;; (fprintf op "(function() { ;; start up the web server
;; return function(success, fail, params) { ;; The web server responds to two types of requests
;; success('ok'); ;; ?comet Starting up the comet request path.
;; }})"))) ;; ?v Getting a value back from evaluation.
;; ;; ?e Got an error.
;; is a do-nothing evaluator that will always give back 'ok'. (void
;; (thread (lambda ()
;; At the moment, the evaluator will pass in a parameter that binds 'currentDisplayer' to a function (define (start req)
;; that captures output. (cond
(define (make-evaluate javascript-compiler) ;; Server-side sync for a program
(define port (+ 8000 (random 8000))) [(exists-binding? 'comet (request-bindings req))
(handle-comet ch req)]
;; Normal result came back
[(exists-binding? 'v (request-bindings req))
(handle-normal-response req)]
;; Error occurred
[(exists-binding? 'e (request-bindings req))
(handle-error-response req)]
[else
(make-on-first-load-response)]))
;; This channel's meant to serialize use of the web server. (serve/servlet start
(define ch (make-channel)) #:banner? #f
#:launch-browser? #t
#:quit? #f
#:port port
#:servlet-path "/eval"))))
;; start up the web server ch))
;; The web server responds to two types of requests
;; ?comet Starting up the comet request path.
;; ?v Getting a value back from evaluation.
;; ?e Got an error.
(void
(thread (lambda ()
(define (start req)
(cond
;; Server-side sync for a program
[(exists-binding? 'comet (request-bindings req))
(handle-comet req)]
;; Normal result came back
[(exists-binding? 'v (request-bindings req))
(handle-normal-response req)]
;; Error occurred
[(exists-binding? 'e (request-bindings req))
(handle-error-response req)]
[else
(make-on-first-load-response)]))
(serve/servlet start
#:banner? #f
#:launch-browser? #t
#:quit? #f
#:port port
#:servlet-path "/eval"))))
(define *alarm-timeout* 30000)
(define *alarm-timeout* 30000) (define (handle-comet ch req)
(let/ec return
(define (handle-comet req) (let* ([alarm (alarm-evt (+ (current-inexact-milliseconds) *alarm-timeout*))]
(let/ec return [javascript-compiler+program (sync ch alarm)]
(let* ([alarm (alarm-evt (+ (current-inexact-milliseconds) *alarm-timeout*))] [javascript-compiler (first javascript-compiler+program)]
[program (sync ch alarm)] [program (second javascript-compiler+program)]
[op (open-output-bytes)]) [op (open-output-bytes)])
(cond (cond
[(eq? program alarm) [(eq? program alarm)
(try-again-response)] (try-again-response)]
[else [else
(with-handlers ([exn:fail? (lambda (exn) (with-handlers ([exn:fail? (lambda (exn)
(let ([sentinel (let ([sentinel
(format (format
#<<EOF #<<EOF
(function () { (function () {
return function(success, fail, params) { return function(success, fail, params) {
fail(~s); fail(~s);
} }
}); });
EOF EOF
(exn-message exn))]) (exn-message exn))])
(return (return
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
#"text/plain; charset=utf-8" #"text/plain; charset=utf-8"
empty empty
(list #"" (string->bytes/utf-8 sentinel))))))]) (list #"" (string->bytes/utf-8 sentinel))))))])
(javascript-compiler program op)) (javascript-compiler program op))
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
#"text/plain; charset=utf-8" #"text/plain; charset=utf-8"
empty empty
(list #"" (get-output-bytes op)))])))) (list #"" (get-output-bytes op)))]))))
(define (try-again-response)
(response/full 200 #"Try again"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" #"")))
(define (ok-response)
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" #"<html><head></head><body><p>ok</p></body></html>")))
(define (handle-normal-response req)
(channel-put ch (make-evaluated (extract-binding/single 'o (request-bindings req))
(extract-binding/single 'v (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))
(extract-binding/single 'b (request-bindings req))))
(ok-response))
(define (handle-error-response req)
(channel-put ch (make-error-happened (define (try-again-response)
(extract-binding/single 'e (request-bindings req)) (response/full 200 #"Try again"
(string->number (current-seconds)
(extract-binding/single 't (request-bindings req))))) #"text/plain; charset=utf-8"
(ok-response)) empty
(list #"" #"")))
(define (ok-response)
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" #"<html><head></head><body><p>ok</p></body></html>")))
(define (make-on-first-load-response)
(let ([op (open-output-bytes)]) (define (handle-normal-response req)
(fprintf op #<<EOF (channel-put ch (make-evaluated (extract-binding/single 'o (request-bindings req))
(extract-binding/single 'v (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))
(extract-binding/single 'b (request-bindings req))))
(ok-response))
(define (handle-error-response req)
(channel-put ch (make-error-happened
(extract-binding/single 'e (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))))
(ok-response))
(define (make-on-first-load-response)
(let ([op (open-output-bytes)])
(fprintf op #<<EOF
<html> <html>
<head> <head>
<script> <script>
@ -378,26 +371,46 @@ var whenLoaded = function() {
</body> </body>
</html> </html>
EOF EOF
) )
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
TEXT/HTML-MIME-TYPE TEXT/HTML-MIME-TYPE
empty empty
(list #"" (get-output-bytes op))))) (list #"" (get-output-bytes op)))))
;; make-evaluate: (Any output-port) -> (sexp -> (values string number))
;; Produce a JavaScript evaluator that cooperates with a browser.
;; The JavaScript-compiler is expected to write out a thunk. When invoked,
;; the thunk should return a function that consumes three values, corresponding
;; to success, failure, and other parameters to evaluation. For example:
;;
;; (make-evaluate (lambda (program op)
;; (fprintf op "(function() {
;; return function(success, fail, params) {
;; success('ok');
;; }})")))
;;
;; is a do-nothing evaluator that will always give back 'ok'.
;;
;; At the moment, the evaluator will pass in a parameter that binds 'currentDisplayer' to a function
;; that captures output.
(define (make-evaluate javascript-compiler)
;; evaluate: sexp -> (values string number) ;; evaluate: sexp -> (values string number)
;; A little driver to test the evalution of expressions, using a browser to help. ;; A little driver to test the evalution of expressions, using a browser to help.
;; Returns the captured result of stdout, plus # of milliseconds it took to execute. ;; Returns the captured result of stdout, plus # of milliseconds it took to execute.
(define (evaluate e) (define (evaluate e)
;; Send the program to the web browser, and wait for the thread to send back ;; Send the program to the web browser, and wait for the thread to send back
(channel-put ch e) (channel-put ch (list javascript-compiler e))
(let ([result (channel-get ch)]) (let ([result (channel-get ch)])
(cond [(error-happened? result) (cond [(error-happened? result)
(raise result)] (raise result)]
[else [else
result]))) result])))
evaluate) evaluate)