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

75
tests/browser-evaluate.rkt
View File

@ -25,30 +25,13 @@
;; 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
;; 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)
(define port (+ 8000 (random 8000))) (define port (+ 8000 (random 8000)))
;; This channel's meant to serialize use of the web server. ;; This channel's meant to serialize use of the web server.
(define ch (make-channel)) (define ch (make-channel))
;; start up the web server ;; start up the web server
;; The web server responds to two types of requests ;; The web server responds to two types of requests
;; ?comet Starting up the comet request path. ;; ?comet Starting up the comet request path.
@ -60,7 +43,7 @@
(cond (cond
;; Server-side sync for a program ;; Server-side sync for a program
[(exists-binding? 'comet (request-bindings req)) [(exists-binding? 'comet (request-bindings req))
(handle-comet req)] (handle-comet ch req)]
;; Normal result came back ;; Normal result came back
[(exists-binding? 'v (request-bindings req)) [(exists-binding? 'v (request-bindings req))
@ -82,12 +65,18 @@
#:servlet-path "/eval")))) #:servlet-path "/eval"))))
(define *alarm-timeout* 30000) ch))
(define (handle-comet req)
(define *alarm-timeout* 30000)
(define (handle-comet ch req)
(let/ec return (let/ec return
(let* ([alarm (alarm-evt (+ (current-inexact-milliseconds) *alarm-timeout*))] (let* ([alarm (alarm-evt (+ (current-inexact-milliseconds) *alarm-timeout*))]
[program (sync ch alarm)] [javascript-compiler+program (sync ch alarm)]
[javascript-compiler (first javascript-compiler+program)]
[program (second javascript-compiler+program)]
[op (open-output-bytes)]) [op (open-output-bytes)])
(cond (cond
[(eq? program alarm) [(eq? program alarm)
@ -120,14 +109,18 @@ EOF
(list #"" (get-output-bytes op)))])))) (list #"" (get-output-bytes op)))]))))
(define (try-again-response)
(define (try-again-response)
(response/full 200 #"Try again" (response/full 200 #"Try again"
(current-seconds) (current-seconds)
#"text/plain; charset=utf-8" #"text/plain; charset=utf-8"
empty empty
(list #"" #""))) (list #"" #"")))
(define (ok-response) (define (ok-response)
(response/full 200 #"Okay" (response/full 200 #"Okay"
(current-seconds) (current-seconds)
TEXT/HTML-MIME-TYPE TEXT/HTML-MIME-TYPE
@ -136,7 +129,7 @@ EOF
(define (handle-normal-response req) (define (handle-normal-response req)
(channel-put ch (make-evaluated (extract-binding/single 'o (request-bindings req)) (channel-put ch (make-evaluated (extract-binding/single 'o (request-bindings req))
(extract-binding/single 'v (request-bindings req)) (extract-binding/single 'v (request-bindings req))
(string->number (string->number
@ -145,7 +138,7 @@ EOF
(ok-response)) (ok-response))
(define (handle-error-response req) (define (handle-error-response req)
(channel-put ch (make-error-happened (channel-put ch (make-error-happened
(extract-binding/single 'e (request-bindings req)) (extract-binding/single 'e (request-bindings req))
(string->number (string->number
@ -153,7 +146,7 @@ EOF
(ok-response)) (ok-response))
(define (make-on-first-load-response) (define (make-on-first-load-response)
(let ([op (open-output-bytes)]) (let ([op (open-output-bytes)])
(fprintf op #<<EOF (fprintf op #<<EOF
<html> <html>
@ -387,17 +380,37 @@ EOF
;; 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)