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

continuing to correct tests

Browse Source
This commit is contained in:
Danny Yoo 2012-09-17 12:59:54 -06:00
parent 7a28a79a23
commit d1b42a1314
1 changed files with 43 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
tests/test-assemble.rkt
View File

@ -40,7 +40,7 @@
(lambda (a-statement+inspector op) (lambda (a-statement+inspector op)
(let* ([a-statement (car a-statement+inspector)] (let* ([a-statement (car a-statement+inspector)]
[inspector (cdr a-statement+inspector)] [inspector (cdr a-statement+inspector)]
[snippet (assemble-statement a-statement)] [snippet (assemble-statement a-statement (make-hash))]
[code [code
(string-append (string-append
"(function() { " "(function() { "
@ -55,7 +55,7 @@
"});")]) "});")])
(displayln snippet) (displayln snippet)
(display code op)))))) (display code op))))))
(define (E-single a-statement (inspector "M.val")) (define (E-single a-statement (inspector "M.v"))
(evaluated-value ((force -E) (cons a-statement inspector)))) (evaluated-value ((force -E) (cons a-statement inspector))))
;; evaluating many expressions[. ;; evaluating many expressions[.
@ -83,7 +83,7 @@
}" }"
inspector) inspector)
(display "})" op)))))) (display "})" op))))))
(define (E-many stmts (inspector "M.val")) (define (E-many stmts (inspector "M.v"))
(evaluated-value ((force -E-many) (cons stmts inspector)))) (evaluated-value ((force -E-many) (cons stmts inspector))))
@ -110,25 +110,25 @@
"#<undefined>") "#<undefined>")
;; But we should see the assignment if we inspect M.proc. ;; But we should see the assignment if we inspect M.proc.
(test (E-single (make-AssignImmediate 'proc (make-Const "Danny")) (test (E-single (make-AssignImmediate 'proc (make-Const "Danny"))
"M.proc") "M.p")
"Danny") "Danny")
(test (E-single (make-PushEnvironment 1 #f) (test (E-single (make-PushEnvironment 1 #f)
"M.env.length") "M.e.length")
"1") "1")
(test (E-single (make-PushEnvironment 20 #f) (test (E-single (make-PushEnvironment 20 #f)
"M.env.length") "M.e.length")
"20") "20")
;; PopEnvironment ;; PopEnvironment
(test (E-many (list (make-PushEnvironment 2 #f)) (test (E-many (list (make-PushEnvironment 2 #f))
"M.env.length") "M.e.length")
"2") "2")
(test (E-many (list (make-PushEnvironment 2 #f) (test (E-many (list (make-PushEnvironment 2 #f)
(make-PopEnvironment (make-Const 1) (make-PopEnvironment (make-Const 1)
(make-Const 0))) (make-Const 0)))
"M.env.length") "M.e.length")
"1") "1")
@ -137,30 +137,30 @@
(test (E-many (list (make-PushEnvironment 2 #f) (test (E-many (list (make-PushEnvironment 2 #f)
(make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-AssignImmediate (make-EnvLexicalReference 0 #f)
(make-Const 12345))) (make-Const 12345)))
"M.env[1]") "M.e[1]")
"12345") "12345")
(test (E-many (list (make-PushEnvironment 2 #f) (test (E-many (list (make-PushEnvironment 2 #f)
(make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-AssignImmediate (make-EnvLexicalReference 0 #f)
(make-Const 12345))) (make-Const 12345)))
"M.env[0]") "M.e[0]")
"#<undefined>") "#<undefined>")
(test (E-many (list (make-PushEnvironment 2 #f) (test (E-many (list (make-PushEnvironment 2 #f)
(make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-AssignImmediate (make-EnvLexicalReference 1 #f)
(make-Const 12345))) (make-Const 12345)))
"M.env[0]") "M.e[0]")
"12345") "12345")
;; Toplevel Environment loading ;; Toplevel Environment loading
(test (E-single (make-Perform (make-ExtendEnvironment/Prefix! '(pi))) (test (E-single (make-Perform (make-ExtendEnvironment/Prefix! '(pi)))
"plt.runtime.toWrittenString(M.env[0]).slice(0, 5)") "plt.runtime.toWrittenString(M.e[0]).slice(0, 5)")
"3.141") "3.141")
;; Simple application ;; Simple application
;; (test (E-many (list (make-Perform (make-ExtendEnvironment/Prefix! '(+))) ;; (test (E-many (list (make-Perform (make-ExtendEnvironment/Prefix! '(+)))
;; (make-AssignImmediate 'proc (make-EnvPrefixReference 0 0)) ;; (make-AssignImmediate 'proc (make-EnvPrefixReference 0 0 #f))
;; (make-PushEnvironment 2 #f) ;; (make-PushEnvironment 2 #f)
;; (make-AssignImmediate (make-EnvLexicalReference 0 #f) ;; (make-AssignImmediate (make-EnvLexicalReference 0 #f)
;; (make-Const 3)) ;; (make-Const 3))
@ -180,7 +180,7 @@
(make-Goto (make-Label 'afterLambda)) (make-Goto (make-Label 'afterLambda))
'afterLambda 'afterLambda
(make-AssignPrimOp 'val (make-MakeCompiledProcedure 'closureStart 0 '() 'closureStart))) (make-AssignPrimOp 'val (make-MakeCompiledProcedure 'closureStart 0 '() 'closureStart)))
"M.val.displayName") "M.v.displayName")
"closureStart") "closureStart")
@ -197,14 +197,14 @@
(make-AssignPrimOp 'val (make-MakeCompiledProcedure 'closureStart 0 (make-AssignPrimOp 'val (make-MakeCompiledProcedure 'closureStart 0
(list 0 1) (list 0 1)
'closureStart))) 'closureStart)))
"M.val.closedVals[1] + ',' + M.val.closedVals[0]") "M.v.closedVals[1] + ',' + M.v.closedVals[0]")
"hello,world") "hello,world")
;; Let's try to install the closure values. ;; Let's try to install the closure values.
(test (E-many (list (make-Goto (make-Label 'afterLambdaBody)) (test (E-many (list (make-Goto (make-Label 'afterLambdaBody))
'closureStart 'closureStart
(make-Perform (make-InstallClosureValues!)) (make-Perform (make-InstallClosureValues! 2))
(make-Goto (make-Label 'theEnd)) (make-Goto (make-Label 'theEnd))
'afterLambdaBody 'afterLambdaBody
@ -220,7 +220,7 @@
(make-Const 0)) (make-Const 0))
(make-Goto (make-Label 'closureStart)) (make-Goto (make-Label 'closureStart))
'theEnd) 'theEnd)
"plt.runtime.toWrittenString(M.env.length) + ',' + M.env[1] + ',' + M.env[0]") "plt.runtime.toWrittenString(M.e.length) + ',' + M.e[1] + ',' + M.e[0]")
"2,hello,world") "2,hello,world")
@ -229,7 +229,7 @@
(test (E-many (list (make-Goto (make-Label 'afterLambdaBody)) (test (E-many (list (make-Goto (make-Label 'afterLambdaBody))
'closureStart 'closureStart
(make-Perform (make-InstallClosureValues!)) (make-Perform (make-InstallClosureValues! 2))
(make-Goto (make-Label 'theEnd)) (make-Goto (make-Label 'theEnd))
'afterLambdaBody 'afterLambdaBody
@ -244,7 +244,7 @@
(make-PopEnvironment (make-Const 2) (make-Const 0)) (make-PopEnvironment (make-Const 2) (make-Const 0))
(make-AssignPrimOp 'val (make-GetCompiledProcedureEntry)) (make-AssignPrimOp 'val (make-GetCompiledProcedureEntry))
'theEnd) 'theEnd)
"typeof(M.val) + ',' + (M.val === M.proc.label)") "typeof(M.v) + ',' + (M.v === M.p.label)")
"function,true") "function,true")
@ -252,7 +252,7 @@
(void (E-many (list (make-Goto (make-Label 'afterLambdaBody)) (void (E-many (list (make-Goto (make-Label 'afterLambdaBody))
'closureStart 'closureStart
(make-Perform (make-InstallClosureValues!)) (make-Perform (make-InstallClosureValues! 2))
(make-Goto (make-Label 'theEnd)) (make-Goto (make-Label 'theEnd))
'afterLambdaBody 'afterLambdaBody
@ -265,7 +265,8 @@
(list 0 1) (list 0 1)
'closureStart)) 'closureStart))
(make-PopEnvironment (make-Const 2) (make-Const 0)) (make-PopEnvironment (make-Const 2) (make-Const 0))
(make-Perform (make-CheckClosureAndArity! (make-Const 5))) (make-AssignImmediate 'argcount (make-Const 5))
(make-Perform (make-CheckClosureAndArity!))
'theEnd))) 'theEnd)))
;; this should fail, since the check is for 1, but the closure expects 5. ;; this should fail, since the check is for 1, but the closure expects 5.
@ -275,7 +276,7 @@
(E-many (list (make-Goto (make-Label 'afterLambdaBody)) (E-many (list (make-Goto (make-Label 'afterLambdaBody))
'closureStart 'closureStart
(make-Perform (make-InstallClosureValues!)) (make-Perform (make-InstallClosureValues! 2))
(make-Goto (make-Label 'theEnd)) (make-Goto (make-Label 'theEnd))
'afterLambdaBody 'afterLambdaBody
@ -288,7 +289,9 @@
(list 0 1) (list 0 1)
'closureStart)) 'closureStart))
(make-PopEnvironment (make-Const 2) (make-Const 0)) (make-PopEnvironment (make-Const 2) (make-Const 0))
(make-Perform (make-CheckClosureAndArity! (make-Const 1))) (make-AssignImmediate 'argcount (make-Const 1))
(make-Perform (make-CheckClosureAndArity!))
'theEnd))) 'theEnd)))
(error 'expected-failure)) (error 'expected-failure))
@ -327,7 +330,7 @@
;; ;; Give a primitive procedure in val ;; ;; Give a primitive procedure in val
;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+))) ;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+)))
;; ,(make-AssignImmediate 'val (make-EnvPrefixReference 0 0)) ;; ,(make-AssignImmediate 'val (make-EnvPrefixReference 0 0 #f))
;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) ;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
;; ,(make-AssignImmediate 'val (make-Const 'not-ok)) ;; ,(make-AssignImmediate 'val (make-Const 'not-ok))
;; ,(make-Goto (make-Label 'end)) ;; ,(make-Goto (make-Label 'end))
@ -338,7 +341,7 @@
;; ;; Give a primitive procedure in proc, but test val ;; ;; Give a primitive procedure in proc, but test val
;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+))) ;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+)))
;; ,(make-AssignImmediate 'proc (make-EnvPrefixReference 0 0)) ;; ,(make-AssignImmediate 'proc (make-EnvPrefixReference 0 0 #f))
;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) ;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
;; ,(make-AssignImmediate 'val (make-Const 'not-a-procedure)) ;; ,(make-AssignImmediate 'val (make-Const 'not-a-procedure))
;; ,(make-Goto (make-Label 'end)) ;; ,(make-Goto (make-Label 'end))
@ -349,7 +352,7 @@
;; ;; Give a primitive procedure in proc and test proc ;; ;; Give a primitive procedure in proc and test proc
;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+))) ;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+)))
;; ,(make-AssignImmediate 'proc (make-EnvPrefixReference 0 0)) ;; ,(make-AssignImmediate 'proc (make-EnvPrefixReference 0 0 #f))
;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue) ;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue)
;; ,(make-AssignImmediate 'val (make-Const 'not-a-procedure)) ;; ,(make-AssignImmediate 'val (make-Const 'not-a-procedure))
;; ,(make-Goto (make-Label 'end)) ;; ,(make-Goto (make-Label 'end))
@ -363,8 +366,8 @@
;; Set-toplevel ;; Set-toplevel
(test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(advisor))) (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(advisor)))
,(make-AssignImmediate 'val (make-Const "Kathi")) ,(make-AssignImmediate 'val (make-Const "Kathi"))
,(make-AssignImmediate (make-EnvPrefixReference 0 0) (make-Reg 'val))) ,(make-AssignImmediate (make-EnvPrefixReference 0 0 #f) (make-Reg 'val)))
"M.env[0][0]") "M.e[0][0]")
"Kathi") "Kathi")
@ -379,9 +382,9 @@
;; check-toplevel-bound shouldn't fail here. ;; check-toplevel-bound shouldn't fail here.
(test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(another-advisor))) (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(another-advisor)))
,(make-AssignImmediate 'val (make-Const "Shriram")) ,(make-AssignImmediate 'val (make-Const "Shriram"))
,(make-AssignImmediate (make-EnvPrefixReference 0 0) (make-Reg 'val)) ,(make-AssignImmediate (make-EnvPrefixReference 0 0 #f) (make-Reg 'val))
,(make-Perform (make-CheckToplevelBound! 0 0))) ,(make-Perform (make-CheckToplevelBound! 0 0)))
"M.env[0][0]") "M.e[0][0]")
"Shriram") "Shriram")
@ -391,7 +394,7 @@
(make-Const '(1 2 3))) (make-Const '(1 2 3)))
,(make-AssignImmediate 'argcount (make-Const 1)) ,(make-AssignImmediate 'argcount (make-Const 1))
,(make-Perform (make-SpliceListIntoStack! (make-Const 0)))) ,(make-Perform (make-SpliceListIntoStack! (make-Const 0))))
"M.argcount + ',' + M.env[0] + ',' + M.env[1] + ',' + M.env[2]") "M.a + ',' + M.e[0] + ',' + M.e[1] + ',' + M.e[2]")
"3,3,2,1") "3,3,2,1")
@ -404,7 +407,7 @@
(make-Const '(1 2 3))) (make-Const '(1 2 3)))
,(make-AssignImmediate 'argcount (make-Const 3)) ,(make-AssignImmediate 'argcount (make-Const 3))
,(make-Perform (make-SpliceListIntoStack! (make-Const 2)))) ,(make-Perform (make-SpliceListIntoStack! (make-Const 2))))
"M.argcount + ',' + M.env[0] + ',' + M.env[1] + ',' + M.env[2] + ',' + M.env[3] + ',' + M.env[4]") "M.a + ',' + M.e[0] + ',' + M.e[1] + ',' + M.e[2] + ',' + M.e[3] + ',' + M.e[4]")
"5,3,2,1,world,hello") "5,3,2,1,world,hello")
@ -420,7 +423,7 @@
,(make-AssignImmediate 'argcount (make-Const 1)) ,(make-AssignImmediate 'argcount (make-Const 1))
,(make-Perform (make-UnspliceRestFromStack! (make-Const 0) ,(make-Perform (make-UnspliceRestFromStack! (make-Const 0)
(make-Const 1)))) (make-Const 1))))
"M.argcount + ',' + plt.runtime.isList(M.env[0])") "M.a + ',' + plt.runtime.isList(M.e[0])")
"1,true") "1,true")
@ -438,7 +441,7 @@
(make-Const 'z)) (make-Const 'z))
,(make-AssignImmediate 'argcount (make-Const 5)) ,(make-AssignImmediate 'argcount (make-Const 5))
,(make-Perform (make-UnspliceRestFromStack! (make-Const 2) (make-Const 3)))) ,(make-Perform (make-UnspliceRestFromStack! (make-Const 2) (make-Const 3))))
"M.argcount + ',' + M.env.length + ',' + plt.runtime.isList(M.env[0]) + ',' + M.env[2] + ',' + M.env[1]") "M.a + ',' + M.e.length + ',' + plt.runtime.isList(M.e[0]) + ',' + M.e[2] + ',' + M.e[1]")
"3,3,true,hello,world") "3,3,true,hello,world")
@ -457,7 +460,7 @@
bad bad
,(make-AssignImmediate 'val (make-Const 'bad)) ,(make-AssignImmediate 'val (make-Const 'bad))
end) end)
"M.val") "M.v")
"ok") "ok")
@ -474,7 +477,7 @@
ok ok
,(make-AssignImmediate 'val (make-Const 'ok)) ,(make-AssignImmediate 'val (make-Const 'ok))
end) end)
"M.val") "M.v")
"ok") "ok")
(test (E-many `(procedure-entry (test (E-many `(procedure-entry
@ -490,7 +493,7 @@
ok ok
,(make-AssignImmediate 'val (make-Const 'ok)) ,(make-AssignImmediate 'val (make-Const 'ok))
end) end)
"M.val") "M.v")
"ok") "ok")
(test (E-many `(procedure-entry (test (E-many `(procedure-entry
@ -506,7 +509,7 @@
bad bad
,(make-AssignImmediate 'val (make-Const 'bad)) ,(make-AssignImmediate 'val (make-Const 'bad))
end) end)
"M.val") "M.v")
"ok") "ok")
@ -521,7 +524,7 @@
'proc 'proc
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry)) (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry))
,(make-AssignImmediate 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 0))) ,(make-AssignImmediate 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 0)))
"M.val") "M.v")
"4") "4")
(test (E-many `(,(make-PushImmediateOntoEnvironment (make-Const 3) #f) (test (E-many `(,(make-PushImmediateOntoEnvironment (make-Const 3) #f)
@ -532,7 +535,7 @@
'proc 'proc
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry)) (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry))
,(make-AssignImmediate 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 1))) ,(make-AssignImmediate 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 1)))
"M.val") "M.v")
"3") "3")