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

need to trace why the browser tests are suddenly failing

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
js-assembler/assemble.rkt
View File

@ -186,7 +186,7 @@ EOF
"")
(cond
[(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)
(let: ([t : String (assemble-target (AssignImmediateStatement-target stmt))]
[v : OpArg (AssignImmediateStatement-value stmt)])

22
js-assembler/package.rkt
View File

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

6
get-dependencies.rkt → make/get-dependencies.rkt
View File

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

8
make-structs.rkt → make/make-structs.rkt
View File

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

24
make.rkt → make/make.rkt
View File

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

8
simulator/simulator.rkt
View File

@ -312,10 +312,10 @@
(cond
[(closure? 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
(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)))]
[else
(error 'check-closure-arity "not a closure: ~s" clos)]))]
@ -325,10 +325,10 @@
(cond
[(primitive-proc? 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
(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)))]
[else
(error 'check-primitive-arity "not a primitive: ~s" clos)]))]

2
tests/browser-evaluate.rkt
View File

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

4
tests/test-browser-evaluate.rkt
View File

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

4
tests/test-conform-browser.rkt
View File

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

4
tests/test-earley-browser.rkt
View File

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

4
tests/test-get-dependencies.rkt
View File

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

4
tests/test-package.rkt
View File

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

2
whalesong.rkt
View File

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