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

test cases print their file name just to help me trace when the tests fail

Browse Source
This commit is contained in:
Danny Yoo 2011-05-23 14:54:38 -04:00
parent 749253d8c4
commit 801b636765
15 changed files with 101 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
compiler.rkt
View File

@ -361,35 +361,46 @@
;; FIXME: assumes the module has already been linked. We should error out
;; if the module hasn't been linked yet.
(define (compile-module-invoke a-module-name)
(let* ([linked (make-label 'linked)]
[already-loaded (make-label 'alreadyLoaded)]
[on-return-multiple (make-label 'onReturnMultiple)]
[on-return (make-LinkedLabel (make-label 'onReturn)
on-return-multiple)])
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestTrue
(make-IsModuleLinked a-module-name))
linked)
;; TODO: raise an exception here that says that the module hasn't been
;; linked yet.
,(make-DebugPrint (make-Const
(format "DEBUG: the module ~a hasn't been linked in!!!"
(ModuleName-name a-module-name))))
,(make-GotoStatement (make-Label already-loaded))
,linked
,(make-TestAndBranchStatement (make-TestTrue
(make-IsModuleInvoked a-module-name))
already-loaded)
,(make-PushControlFrame/Call on-return)
,(make-GotoStatement (ModuleEntry a-module-name))
,on-return-multiple
,(make-PopEnvironment (make-SubtractArg (make-Reg 'argcount)
(make-Const 1))
(make-Const 0))
,on-return
,already-loaded))))
(cond
[(kernel-module-name? a-module-name)
empty-instruction-sequence]
[else
(let* ([linked (make-label 'linked)]
[already-loaded (make-label 'alreadyLoaded)]
[on-return-multiple (make-label 'onReturnMultiple)]
[on-return (make-LinkedLabel (make-label 'onReturn)
on-return-multiple)])
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestTrue
(make-IsModuleLinked a-module-name))
linked)
;; TODO: raise an exception here that says that the module hasn't been
;; linked yet.
,(make-DebugPrint (make-Const
(format "DEBUG: the module ~a hasn't been linked in!!!"
(ModuleName-name a-module-name))))
,(make-GotoStatement (make-Label already-loaded))
,linked
,(make-TestAndBranchStatement (make-TestTrue
(make-IsModuleInvoked a-module-name))
already-loaded)
,(make-PushControlFrame/Call on-return)
,(make-GotoStatement (ModuleEntry a-module-name))
,on-return-multiple
,(make-PopEnvironment (make-SubtractArg (make-Reg 'argcount)
(make-Const 1))
(make-Const 0))
,on-return
,already-loaded)))]))
(: kernel-module-name? (ModuleName -> Boolean))
;; Produces true if the module is hardcoded.
(define (kernel-module-name? name)
(or (and (eq? (ModuleName-name name) '#%kernel)
(eq? (ModuleName-real-path name) '#%kernel))
(eq? (ModuleName-name name) 'whalesong/lang/kernel)))

11
js-assembler/assemble.rkt
View File

@ -12,7 +12,8 @@
racket/string
racket/list)
(provide assemble/write-invoke
(provide assemble/write-invoke-module-as-main
assemble/write-invoke
fracture
assemble-basic-block
assemble-statement)
@ -23,6 +24,14 @@
(: assemble/write-invoke-module-as-main (Symbol Output-Port -> Void))
(define (assemble/write-invoke-module-as-main module-name op)
;; FIXME
(void))
(: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
;; Writes out the JavaScript code that represents the anonymous invocation expression.
;; What's emitted is a function expression that, when invoked, runs the

8
js-assembler/mini-runtime.js
View File

@ -1108,6 +1108,7 @@
};
var HaltError = function() {}
var trampoline = function(MACHINE, initialJump) {
@ -1138,7 +1139,10 @@
0);
return;
}
} else {
} else if (e instanceof HaltError) {
// FIXME: work out what it really means to Halt.
return;
} else {
MACHINE.running = false;
return MACHINE.params.currentErrorHandler(MACHINE, e);
}
@ -1248,6 +1252,6 @@
exports['heir'] = heir;
exports['makeClassPredicate'] = makeClassPredicate;
exports['HaltError'] = HaltError;
}).call(this);

24
package.rkt → js-assembler/package.rkt
View File

@ -1,17 +1,17 @@
#lang racket/base
(require "compiler.rkt"
"compiler-structs.rkt"
"parse-bytecode.rkt"
"language-namespace.rkt"
"il-structs.rkt"
"bootstrapped-primitives.rkt"
"get-module-bytecode.rkt"
"get-dependencies.rkt"
"js-assembler/assemble.rkt"
"js-assembler/get-runtime.rkt"
"lexical-structs.rkt"
"quote-cdata.rkt"
(require "assemble.rkt"
"get-runtime.rkt"
"../compiler.rkt"
"../compiler-structs.rkt"
"../parse-bytecode.rkt"
"../language-namespace.rkt"
"../il-structs.rkt"
"../bootstrapped-primitives.rkt"
"../get-module-bytecode.rkt"
"../get-dependencies.rkt"
"../lexical-structs.rkt"
"../quote-cdata.rkt"
racket/runtime-path
racket/port
racket/list

2
tests/test-assemble.rkt
View File

@ -9,6 +9,8 @@
racket/promise
racket/runtime-path)
(printf "test-assemble.rkt\n")
(define runtime (get-runtime))

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

@ -1,8 +1,9 @@
#lang racket
(require "../js-assembler/get-runtime.rkt"
"../browser-evaluate.rkt"
"../package.rkt")
"../js-assembler/package.rkt")
(printf "test-browser-evaluate.rkt\n")
(define should-follow? (lambda (p) #t))

2
tests/test-compiler-2.rkt
View File

@ -5,7 +5,7 @@
"../simulator/simulator-helpers.rkt"
"test-helpers.rkt")
(printf "test-compiler-2.rkt\n")
;; run: machine -> (machine number)
;; Run the machine to completion.

19
tests/test-compiler.rkt
View File

@ -5,7 +5,10 @@
"../simulator/simulator-helpers.rkt"
"../parameters.rkt"
"test-helpers.rkt"
racket/runtime-path)
racket/runtime-path
rackunit)
(printf "test-compiler.rkt\n")
(define-runtime-path this-test-path ".")
@ -1339,12 +1342,16 @@
#:with-bootstrapping? #t)
(parameterize ([current-module-path (build-path this-test-path "foo.rkt")])
(test '(module foo racket/base
(printf "hello world"))
(make-undefined)
(parameterize ([current-module-path (build-path this-test-path "foo.rkt")]
[current-simulated-output-port (open-output-bytes)])
(test '(module foo '#%kernel
(display "hello world")
(newline))
(void)
#:as-main-module 'whalesong/tests/foo.rkt
#:with-bootstrapping? #t))
#:with-bootstrapping? #t)
(check-equal? (get-output-bytes (current-simulated-output-port))
#"hello world\n"))

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

@ -1,10 +1,12 @@
#lang racket
(require "../browser-evaluate.rkt"
"../package.rkt"
"../js-assembler/package.rkt"
"../js-assembler/get-runtime.rkt"
racket/port
racket/runtime-path)
(printf "test-conform-browser.rkt\n")
(define-runtime-path conform-path (build-path "conform"))

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

@ -1,12 +1,14 @@
#lang racket
(require "../browser-evaluate.rkt"
"../package.rkt"
"../js-assembler/package.rkt"
"../js-assembler/get-runtime.rkt"
racket/port
racket/runtime-path
racket/runtime-path
(for-syntax racket/base))
(printf "test-earley-browser.rkt\n")
(define-runtime-path earley-file-path (build-path "earley"))

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

@ -7,6 +7,8 @@
racket/runtime-path
rackunit)
(printf "test-get-dependencies.rkt\n")
(define-runtime-path compiler-path "..")

3
tests/test-package.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
(require "../package.rkt")
(require "../js-assembler/package.rkt")
(printf "test-package.rkt\n")
(define (follow? p)

2
tests/test-parse-bytecode.rkt
View File

@ -11,6 +11,8 @@
racket/runtime-path
(for-syntax racket/base))
(printf "test-parse-bytecode.rkt\n")
(define-runtime-path this-test-path ".")
(define (run-zo-parse stx)

2
tests/test-parse.rkt
View File

@ -6,6 +6,8 @@
"../lam-entry-gensym.rkt"
(for-syntax racket/base))
(printf "test-parse.rkt\n");
; Test out the compiler, using the simulator.
(define-syntax (test stx)
(syntax-case stx ()

2
tests/test-simulator.rkt
View File

@ -6,6 +6,8 @@
"../simulator/simulator-primitives.rkt"
"../simulator/simulator.rkt")
(printf "test-simulator.rkt\n")
(define-syntax (test stx)
(syntax-case stx ()