need to trace why the browser tests are suddenly failing

This commit is contained in:
Danny Yoo 2011-06-08 14:37:04 -04:00
parent 710fae7eab
commit 6f3c22963e
13 changed files with 49 additions and 45 deletions

View File

@ -186,7 +186,7 @@ EOF
"") "")
(cond (cond
[(DebugPrint? stmt) [(DebugPrint? stmt)
(format "MACHINE.params.currentOutputPort.write(MACHINE, ~a);" (assemble-oparg (DebugPrint-value stmt)))] (format "MACHINE.params.currentOutputPort.writeDomNode(MACHINE, $('<span/>').text(~a));" (assemble-oparg (DebugPrint-value stmt)))]
[(AssignImmediateStatement? stmt) [(AssignImmediateStatement? stmt)
(let: ([t : String (assemble-target (AssignImmediateStatement-target stmt))] (let: ([t : String (assemble-target (AssignImmediateStatement-target stmt))]
[v : OpArg (AssignImmediateStatement-value stmt)]) [v : OpArg (AssignImmediateStatement-value stmt)])

View File

@ -2,8 +2,8 @@
(require "assemble.rkt" (require "assemble.rkt"
"quote-cdata.rkt" "quote-cdata.rkt"
"../make.rkt" "../make/make.rkt"
"../make-structs.rkt" "../make/make-structs.rkt"
"../parameters.rkt" "../parameters.rkt"
(planet dyoo/closure-compile:1:1) (planet dyoo/closure-compile:1:1)
(prefix-in runtime: "get-runtime.rkt") (prefix-in runtime: "get-runtime.rkt")
@ -28,11 +28,11 @@
(define (package-anonymous source-code (define (package-anonymous source-code
#:should-follow? should-follow? #:should-follow-children? should-follow?
#:output-port op) #:output-port op)
(fprintf op "(function() {\n") (fprintf op "(function() {\n")
(package source-code (package source-code
#:should-follow? should-follow? #:should-follow-children? should-follow?
#:output-port op) #:output-port op)
(fprintf op " return invoke; })\n")) (fprintf op " return invoke; })\n"))
@ -41,15 +41,17 @@
;; package: Source (path -> boolean) output-port -> void ;; package: Source (path -> boolean) output-port -> void
;; Compile package for the given source program. should-follow? ;; Compile package for the given source program.
;; indicates whether we should continue following module paths. ;;
;; should-follow-children? indicates whether we should continue
;; following module paths of a source's dependencies.
;; ;;
;; The generated output defines a function called 'invoke' with ;; The generated output defines a function called 'invoke' with
;; four arguments (MACHINE, SUCCESS, FAIL, PARAMS). When called, it will ;; four arguments (MACHINE, SUCCESS, FAIL, PARAMS). When called, it will
;; execute the code to either run standalone expressions or ;; execute the code to either run standalone expressions or
;; load in modules. ;; load in modules.
(define (package source-code (define (package source-code
#:should-follow? should-follow? #:should-follow-children? should-follow?
#:output-port op) #:output-port op)
(define packaging-configuration (define packaging-configuration
(make-Configuration (make-Configuration
@ -93,7 +95,7 @@
(define (write-runtime op) (define (write-runtime op)
(let ([packaging-configuration (let ([packaging-configuration
(make-Configuration (make-Configuration
;; should-follow? ;; should-follow-children?
(lambda (src p) #t) (lambda (src p) #t)
;; on ;; on
(lambda (src ast stmts) (lambda (src ast stmts)
@ -158,7 +160,7 @@ EOF
(define (get-code source-code) (define (get-code source-code)
(let ([buffer (open-output-string)]) (let ([buffer (open-output-string)])
(package source-code (package source-code
#:should-follow? (lambda (src p) #t) #:should-follow-children? (lambda (src p) #t)
#:output-port buffer) #:output-port buffer)
(compress (compress
(get-output-string buffer)))) (get-output-string buffer))))
@ -176,7 +178,7 @@ EOF
;; write-standalone-code: source output-port -> void ;; write-standalone-code: source output-port -> void
(define (write-standalone-code source-code op) (define (write-standalone-code source-code op)
(package-anonymous source-code (package-anonymous source-code
#:should-follow? (lambda (src p) #t) #:should-follow-children? (lambda (src p) #t)
#:output-port op) #:output-port op)
(fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n")) (fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n"))

View File

@ -1,7 +1,7 @@
#lang typed/racket/base #lang typed/racket/base
(require "compiler/expression-structs.rkt" (require "../compiler/expression-structs.rkt"
"compiler/lexical-structs.rkt" "../compiler/lexical-structs.rkt"
"sets.rkt") "../sets.rkt")
;; Collect the complete list of dependencies for a module. ;; Collect the complete list of dependencies for a module.

View File

@ -1,8 +1,8 @@
#lang typed/racket/base #lang typed/racket/base
(require "compiler/il-structs.rkt" (require "../compiler/il-structs.rkt"
"compiler/bootstrapped-primitives.rkt" "../compiler/bootstrapped-primitives.rkt"
"compiler/expression-structs.rkt" "../compiler/expression-structs.rkt"
"get-dependencies.rkt") "get-dependencies.rkt")
@ -26,7 +26,7 @@
(define-struct: Configuration (define-struct: Configuration
([should-follow? : (Source Path -> Boolean)] ([should-follow-children? : (Source Path -> Boolean)]
[on-module-statements : (Source [on-module-statements : (Source
(U Expression #f) (U Expression #f)
(Listof Statement) (Listof Statement)

View File

@ -1,22 +1,22 @@
#lang typed/racket/base #lang typed/racket/base
(require "compiler/compiler.rkt" (require "../compiler/compiler.rkt"
"compiler/il-structs.rkt" "../compiler/il-structs.rkt"
"compiler/lexical-structs.rkt" "../compiler/lexical-structs.rkt"
"compiler/compiler-structs.rkt" "../compiler/compiler-structs.rkt"
"compiler/expression-structs.rkt" "../compiler/expression-structs.rkt"
"../parameters.rkt"
"../sets.rkt"
"get-dependencies.rkt" "get-dependencies.rkt"
"parameters.rkt"
"sets.rkt"
"make-structs.rkt" "make-structs.rkt"
racket/list racket/list
racket/match) racket/match)
(require/typed "parser/parse-bytecode.rkt" (require/typed "../parser/parse-bytecode.rkt"
[parse-bytecode (Any -> Expression)]) [parse-bytecode (Any -> Expression)])
(require/typed "get-module-bytecode.rkt" (require/typed "../get-module-bytecode.rkt"
[get-module-bytecode ((U String Path Input-Port) -> Bytes)]) [get-module-bytecode ((U String Path Input-Port) -> Bytes)])
@ -96,7 +96,7 @@
((inst new-seteq Symbol))]) ((inst new-seteq Symbol))])
(match config (match config
[(struct Configuration (should-follow? [(struct Configuration (should-follow-children?
on-module-statements on-module-statements
after-module-statements after-module-statements
after-last)) after-last))
@ -113,6 +113,8 @@
[(eq? ast #f) [(eq? ast #f)
empty] empty]
[else [else
;; FIXME: the logic here is wrong.
;; Needs to check should-follow-children before continuing here.
(let* ([dependent-module-names (get-dependencies ast)] (let* ([dependent-module-names (get-dependencies ast)]
[paths [paths
(foldl (lambda: ([mp : ModuleLocator] (foldl (lambda: ([mp : ModuleLocator]
@ -123,7 +125,7 @@
mp) mp)
acc] acc]
[(and (path? rp) [(and (path? rp)
(should-follow? this-source rp) (should-follow-children? this-source rp)
(cons (make-ModuleSource rp) (cons (make-ModuleSource rp)
acc))] acc))]
[else [else

View File

@ -312,10 +312,10 @@
(cond (cond
[(closure? clos) [(closure? clos)
(if (arity-match? (closure-arity clos) (if (arity-match? (closure-arity clos)
(ensure-natural (evaluate-oparg m (CheckClosureArity!-arity op)))) (ensure-natural (evaluate-oparg m (CheckClosureArity!-num-args op))))
'ok 'ok
(error 'check-closure-arity "arity mismatch: passed ~s args to ~s" (error 'check-closure-arity "arity mismatch: passed ~s args to ~s"
(ensure-natural (evaluate-oparg m (CheckClosureArity!-arity op))) (ensure-natural (evaluate-oparg m (CheckClosureArity!-num-args op)))
(closure-display-name clos)))] (closure-display-name clos)))]
[else [else
(error 'check-closure-arity "not a closure: ~s" clos)]))] (error 'check-closure-arity "not a closure: ~s" clos)]))]
@ -325,10 +325,10 @@
(cond (cond
[(primitive-proc? clos) [(primitive-proc? clos)
(if (arity-match? (primitive-proc-arity clos) (if (arity-match? (primitive-proc-arity clos)
(ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-arity op)))) (ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-num-args op))))
'ok 'ok
(error 'check-primitive-arity "arity mismatch: passed ~s args to ~s" (error 'check-primitive-arity "arity mismatch: passed ~s args to ~s"
(ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-arity op))) (ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-num-args op)))
(primitive-proc-display-name clos)))] (primitive-proc-display-name clos)))]
[else [else
(error 'check-primitive-arity "not a primitive: ~s" clos)]))] (error 'check-primitive-arity "not a primitive: ~s" clos)]))]

View File

@ -236,7 +236,7 @@ var comet = function() {
var onFail = function(machine, e) { var onFail = function(machine, e) {
endTime = new Date(); endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(comet, 0); }, sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"e=" + encodeURIComponent(String(e)) + "e=" + encodeURIComponent(String(e.stack || e)) +
"&t=" + encodeURIComponent(String(endTime - startTime))); "&t=" + encodeURIComponent(String(endTime - startTime)));
}; };
startTime = new Date(); startTime = new Date();

View File

@ -1,7 +1,7 @@
#lang racket #lang racket
(require "browser-evaluate.rkt" (require "browser-evaluate.rkt"
"../js-assembler/package.rkt" "../js-assembler/package.rkt"
"../make-structs.rkt") "../make/make-structs.rkt")
(printf "test-browser-evaluate.rkt\n") (printf "test-browser-evaluate.rkt\n")
@ -20,7 +20,7 @@
(fprintf op "var innerInvoke = ") (fprintf op "var innerInvoke = ")
(package-anonymous (make-SexpSource program) (package-anonymous (make-SexpSource program)
#:should-follow? should-follow? #:should-follow-children? should-follow?
#:output-port op) #:output-port op)
(fprintf op "();\n") (fprintf op "();\n")

View File

@ -1,7 +1,7 @@
#lang racket #lang racket
(require "browser-evaluate.rkt" (require "browser-evaluate.rkt"
"../js-assembler/package.rkt" "../js-assembler/package.rkt"
"../make-structs.rkt" "../make/make-structs.rkt"
racket/port racket/port
racket/runtime-path) racket/runtime-path)
@ -21,7 +21,7 @@
(fprintf op "var innerInvoke = ") (fprintf op "var innerInvoke = ")
(package-anonymous (make-SexpSource program) (package-anonymous (make-SexpSource program)
#:should-follow? (lambda (src p) #t) #:should-follow-children? (lambda (src p) #t)
#:output-port op) #:output-port op)
(fprintf op "();\n") (fprintf op "();\n")

View File

@ -1,7 +1,7 @@
#lang racket #lang racket
(require "browser-evaluate.rkt" (require "browser-evaluate.rkt"
"../js-assembler/package.rkt" "../js-assembler/package.rkt"
"../make-structs.rkt" "../make/make-structs.rkt"
racket/port racket/port
racket/runtime-path racket/runtime-path
racket/runtime-path racket/runtime-path
@ -23,7 +23,7 @@
(fprintf op "var innerInvoke = ") (fprintf op "var innerInvoke = ")
(package-anonymous (make-SexpSource program) (package-anonymous (make-SexpSource program)
#:should-follow? (lambda (src path) #t) #:should-follow-children? (lambda (src path) #t)
#:output-port op) #:output-port op)
(fprintf op "();\n") (fprintf op "();\n")

View File

@ -1,5 +1,5 @@
#lang racket #lang racket
(require "../get-dependencies.rkt" (require "../make/get-dependencies.rkt"
"../get-module-bytecode.rkt" "../get-module-bytecode.rkt"
"../parser/parse-bytecode.rkt" "../parser/parse-bytecode.rkt"
"../compiler/lexical-structs.rkt" "../compiler/lexical-structs.rkt"
@ -11,7 +11,7 @@
(define-runtime-path get-dependencies-path (define-runtime-path get-dependencies-path
(build-path ".." "get-dependencies.rkt")) (build-path ".." "make" "get-dependencies.rkt"))
(define-runtime-path get-module-bytecode-path (define-runtime-path get-module-bytecode-path
(build-path ".." "get-module-bytecode.rkt")) (build-path ".." "get-module-bytecode.rkt"))

View File

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require "../js-assembler/package.rkt" (require "../js-assembler/package.rkt"
"../make-structs.rkt") "../make/make-structs.rkt")
(printf "test-package.rkt\n") (printf "test-package.rkt\n")
@ -11,7 +11,7 @@
(define (test s-exp) (define (test s-exp)
(package (make-SexpSource s-exp) (package (make-SexpSource s-exp)
#:should-follow? follow? #:should-follow-children? follow?
#:output-port (open-output-string) #;(current-output-port))) #:output-port (open-output-string) #;(current-output-port)))

View File

@ -3,7 +3,7 @@
(require racket/list (require racket/list
racket/string racket/string
"make-structs.rkt" "make/make-structs.rkt"
"js-assembler/package.rkt") "js-assembler/package.rkt")