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

fixing test cases

Browse Source
This commit is contained in:
Danny Yoo 2011-03-15 00:03:25 -04:00
parent c783850732
commit 91f244526e
1 changed files with 21 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
test-simulator.rkt
View File

@ -319,13 +319,15 @@
(let ([m (let ([m
(make-machine (make-undefined) (make-closure 'procedure-entry (make-machine (make-undefined) (make-closure 'procedure-entry
0 0
(list 1 2 3)) (list 1 2 3)
'procedure-entry)
(list true false) ;; existing environment holds true, false (list true false) ;; existing environment holds true, false
'() '()
0 0
(list->vector `(,(make-PerformStatement (make-InstallClosureValues!)) (list->vector `(,(make-PerformStatement (make-InstallClosureValues!))
procedure-entry)) procedure-entry))
0)]) 0
(make-hash))])
(test (machine-env (run m)) (test (machine-env (run m))
;; Check that the environment has installed the expected closure values. ;; Check that the environment has installed the expected closure values.
(list 1 2 3 true false))) (list 1 2 3 true false)))
@ -334,12 +336,13 @@
;; get-compiled-procedure-entry ;; get-compiled-procedure-entry
(let ([m (let ([m
(make-machine (make-undefined) (make-machine (make-undefined)
(make-closure 'procedure-entry 0 (list 1 2 3)) (make-closure 'procedure-entry 0 (list 1 2 3) 'procedure-entry)
(list true false) ;; existing environment holds true, false (list true false) ;; existing environment holds true, false
'() '()
0 0
(list->vector `(,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)))) (list->vector `(,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))))
0)]) 0
(make-hash))])
(test (machine-val (run m)) (test (machine-val (run m))
'procedure-entry)) 'procedure-entry))
@ -347,13 +350,13 @@
;; make-compiled-procedure, with empty closure set ;; make-compiled-procedure, with empty closure set
(let ([m (new-machine `(,(make-AssignPrimOpStatement (let ([m (new-machine `(,(make-AssignPrimOpStatement
'val 'val
(make-MakeCompiledProcedure 'procedure-entry 0 (list))) (make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry))
,(make-GotoStatement (make-Label 'end)) ,(make-GotoStatement (make-Label 'end))
procedure-entry procedure-entry
end end
))]) ))])
(test (machine-val (run m)) (test (machine-val (run m))
(make-closure 'procedure-entry 0 (list)))) (make-closure 'procedure-entry 0 (list) 'procedure-entry)))
;; make-compiled-procedure: Capturing a few variables. ;; make-compiled-procedure: Capturing a few variables.
(let ([m (new-machine `(,(make-PushEnvironment 3 #f) (let ([m (new-machine `(,(make-PushEnvironment 3 #f)
@ -365,13 +368,15 @@
(make-MakeCompiledProcedure 'procedure-entry (make-MakeCompiledProcedure 'procedure-entry
0 0
(list (make-EnvLexicalReference 0 #f) (list (make-EnvLexicalReference 0 #f)
(make-EnvLexicalReference 2 #f)))) (make-EnvLexicalReference 2 #f))
'procedure-entry))
,(make-GotoStatement (make-Label 'end)) ,(make-GotoStatement (make-Label 'end))
procedure-entry procedure-entry
end end
))]) ))])
(test (machine-val (run m)) (test (machine-val (run m))
(make-closure 'procedure-entry 0 (list 'larry 'moe)))) (make-closure 'procedure-entry 0 (list 'larry 'moe)
'procedure-entry)))
;; make-compiled-procedure: Capturing a toplevel. ;; make-compiled-procedure: Capturing a toplevel.
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(x y z))) (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(x y z)))
@ -385,13 +390,15 @@
'val 'val
(make-MakeCompiledProcedure 'procedure-entry (make-MakeCompiledProcedure 'procedure-entry
0 0
(list (make-EnvWholePrefixReference 0)))) (list (make-EnvWholePrefixReference 0))
'procedure-entry))
,(make-GotoStatement (make-Label 'end)) ,(make-GotoStatement (make-Label 'end))
procedure-entry procedure-entry
end end
))]) ))])
(test (machine-val (run m)) (test (machine-val (run m))
(make-closure 'procedure-entry 0 (list (make-toplevel (list "x" "y" "z")))))) (make-closure 'procedure-entry 0 (list (make-toplevel (list "x" "y" "z")))
'procedure-entry)))
;; make-compiled-procedure: Capturing both a toplevel and some lexical values ;; make-compiled-procedure: Capturing both a toplevel and some lexical values
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(x y z))) (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(x y z)))
@ -412,7 +419,8 @@
0 0
(list (make-EnvWholePrefixReference 3) (list (make-EnvWholePrefixReference 3)
(make-EnvLexicalReference 0 #f) (make-EnvLexicalReference 0 #f)
(make-EnvLexicalReference 2 #f)))) (make-EnvLexicalReference 2 #f))
'procedure-entry))
,(make-PopEnvironment 3 0) ,(make-PopEnvironment 3 0)
,(make-GotoStatement (make-Label 'end)) ,(make-GotoStatement (make-Label 'end))
procedure-entry procedure-entry
@ -423,7 +431,8 @@
0 0
(list (make-toplevel (list "x" "y" "z")) (list (make-toplevel (list "x" "y" "z"))
'larry 'larry
'moe)))) 'moe)
'procedure-entry)))
;; Test toplevel lookup ;; Test toplevel lookup