Merge branch 'master' into structs

tests/browser-evaluate.rkt

@@ -225,7 +225,10 @@ var comet = function() {
                                                          $(document.body).append(v);
                                                          output.push($(v).text()); } };
 
+                    var successCalled = false;
                     var onSuccess = function(v) {
+                        if (successCalled) { return; }
+                        successCalled = true;
                         endTime = new Date();
                         sendRequest("/eval", function(req) { setTimeout(comet, 0); },
                             "v=" + encodeURIComponent(String(v)) +
@@ -234,7 +237,10 @@ var comet = function() {
                             "&b=" + encodeURIComponent(String(BrowserDetect.browser + ' ' + BrowserDetect.version + '/' + BrowserDetect.OS)));
                     };
 
+                    var failCalled = false;
                     var onFail = function(machine, e) {
+                        if (failCalled) { return; }
+                        failCalled = true;
                         endTime = new Date();
                         sendRequest("/eval", function(req) { setTimeout(comet, 0); },
                             "e=" + encodeURIComponent(String(e.stack || e)) +

tests/browser-harness.rkt

@@ -0,0 +1,90 @@
+#lang racket/base
+
+
+;; Provides a harness for running programs on the browser and
+;; examining their results.
+
+;; Provides a test form that expects the path of a program and its
+;; expected output.
+
+
+(require "browser-evaluate.rkt"
+         "../js-assembler/package.rkt"
+         "../make/make-structs.rkt"
+         racket/port
+         racket/path
+         racket/runtime-path
+         racket/runtime-path
+         (for-syntax racket/base
+                     racket/port))
+
+(define evaluate (make-evaluate 
+                  (lambda (program op)
+
+                    (fprintf op "(function () {")
+                    
+   		    (displayln (get-runtime) op)
+                    
+                    (newline op)
+                    
+                    (fprintf op "var innerInvoke = ")
+                    (package-anonymous program
+                                       #:should-follow-children? (lambda (src) #t)
+                                       #:output-port op)
+                    (fprintf op "();\n")
+                    
+                    (fprintf op #<<EOF
+return (function(succ, fail, params) {
+            var machine = new plt.runtime.Machine();
+            return innerInvoke(machine,
+                               function() { plt.runtime.invokeMains(machine, succ, fail); },
+                               fail,
+                               params);
+        });
+});
+EOF
+                             )
+                    
+                    )))
+
+
+
+;; We use a customized error structure that supports
+;; source location reporting.
+(define-struct (exn:fail:error-on-test exn:fail)
+  (srcloc)
+  #:property prop:exn:srclocs
+             (lambda (a-struct)
+               (list (exn:fail:error-on-test-srcloc a-struct))))
+
+
+
+
+(define-syntax (test stx)
+  (syntax-case stx ()
+    [(_ source-file-path expected-file-path)
+     (with-syntax ([stx stx]
+                   [exp (call-with-input-file (syntax-e #'expected-file-path)
+                          port->string)])
+       (quasisyntax/loc #'stx
+         (begin
+           (printf "running test on ~s..." source-file-path)
+           (let* ([src-path (normalize-path source-file-path)]
+                  [result (evaluate (make-MainModuleSource (make-ModuleSource src-path)))]
+                  [output (evaluated-stdout result)])
+             (cond [(string=? output exp)
+                    (printf " ok (~a milliseconds)\n" (evaluated-t result))]
+                   [else
+                    (printf " error!\n")
+                    (raise (make-exn:fail:error-on-test
+                            (format "Expected ~s, got ~s" exp output)
+                            (current-continuation-marks)
+                            (srcloc '#,(syntax-source #'stx)
+                                    '#,(syntax-line #'stx)
+                                    '#,(syntax-column #'stx)
+                                    '#,(syntax-position #'stx)
+                                    '#,(syntax-span #'stx))))])))))]))
+           
+
+
+(provide test)

tests/more-tests/hello.expected

@@ -0,0 +1 @@
+hello world

tests/more-tests/hello.rkt

@@ -0,0 +1,2 @@
+#lang planet dyoo/whalesong
+(displayln "hello world")

tests/more-tests/run-more-tests.rkt

@@ -0,0 +1,6 @@
+#lang racket
+
+(require "../browser-harness.rkt")
+
+(test "hello.rkt" "hello.expected")
+(test "simple-structs.rkt" "simple-structs.expected")

tests/more-tests/simple-structs.expected

@@ -0,0 +1,2 @@
+3
+4

tests/more-tests/simple-structs.rkt

@@ -0,0 +1,6 @@
+#lang planet dyoo/whalesong
+(define-struct p (f r))
+
+(define p1 (make-p 3 4))
+(p-f p1)
+(p-r p1)

tests/test-all.rkt

@@ -10,7 +10,8 @@
          "test-package.rkt"
          "test-conform-browser.rkt"
          "test-earley-browser.rkt"
-         "test-get-dependencies.rkt")
+         "test-get-dependencies.rkt"
+         "more-tests/run-more-tests.rkt")
 
 
 ;; This test takes a bit too much time.