From 7a28a79a23b8af3997be0483986bc0632625d076 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Mon, 17 Sep 2012 12:40:22 -0600 Subject: [PATCH] repairing test cases that staled earlier --- js-assembler/package.rkt | 17 ++- tests/test-assemble.rkt | 272 +++++++++++++++++----------------- tests/test-parse-bytecode.rkt | 35 +++-- tests/test-parse.rkt | 6 +- 4 files changed, 164 insertions(+), 166 deletions(-) diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index 2e4ff92..5d636a4 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -41,6 +41,7 @@ (provide package + package-anonymous package-standalone-xhtml get-inert-code get-standalone-code @@ -101,14 +102,14 @@ -;; (define (package-anonymous source-code -;; #:should-follow-children? should-follow? -;; #:output-port op) -;; (fprintf op "(function() {\n") -;; (package source-code -;; #:should-follow-children? should-follow? -;; #:output-port op) -;; (fprintf op " return invoke; })\n")) +(define (package-anonymous source-code + #:should-follow-children? should-follow? + #:output-port op) + (fprintf op "(function() {\n") + (package source-code + #:should-follow-children? should-follow? + #:output-port op) + (fprintf op " return invoke; })\n")) diff --git a/tests/test-assemble.rkt b/tests/test-assemble.rkt index e92b5d3..49c6b2b 100644 --- a/tests/test-assemble.rkt +++ b/tests/test-assemble.rkt @@ -94,22 +94,22 @@ ;; Assigning a number -(test (E-single (make-AssignImmediateStatement 'val (make-Const 42))) +(test (E-single (make-AssignImmediate 'val (make-Const 42))) "42") ;; Assigning a string -(test (E-single (make-AssignImmediateStatement 'val (make-Const "Danny"))) +(test (E-single (make-AssignImmediate 'val (make-Const "Danny"))) "Danny") ;; Assigning a cons -(test (E-single (make-AssignImmediateStatement 'val (make-Const (cons 1 2)))) +(test (E-single (make-AssignImmediate 'val (make-Const (cons 1 2)))) "(1 . 2)") ;; Assigning a void -(test (E-single (make-AssignImmediateStatement 'val (make-Const (void)))) +(test (E-single (make-AssignImmediate 'val (make-Const (void)))) "#") ;; Assigning to proc means val should still be uninitialized. -(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny"))) +(test (E-single (make-AssignImmediate 'proc (make-Const "Danny"))) "#") ;; But we should see the assignment if we inspect M.proc. -(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny")) +(test (E-single (make-AssignImmediate 'proc (make-Const "Danny")) "M.proc") "Danny") @@ -135,39 +135,39 @@ ;; Assigning to the environment (test (E-many (list (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const 12345))) "M.env[1]") "12345") (test (E-many (list (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const 12345))) "M.env[0]") "#") (test (E-many (list (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + (make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const 12345))) "M.env[0]") "12345") ;; Toplevel Environment loading -(test (E-single (make-PerformStatement (make-ExtendEnvironment/Prefix! '(pi))) +(test (E-single (make-Perform (make-ExtendEnvironment/Prefix! '(pi))) "plt.runtime.toWrittenString(M.env[0]).slice(0, 5)") "3.141") ;; Simple application -;; (test (E-many (list (make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) -;; (make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0)) +;; (test (E-many (list (make-Perform (make-ExtendEnvironment/Prefix! '(+))) +;; (make-AssignImmediate 'proc (make-EnvPrefixReference 0 0)) ;; (make-PushEnvironment 2 #f) -;; (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) +;; (make-AssignImmediate (make-EnvLexicalReference 0 #f) ;; (make-Const 3)) -;; (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) +;; (make-AssignImmediate (make-EnvLexicalReference 1 #f) ;; (make-Const 4)) -;; (make-AssignImmediateStatement 'argcount (make-Const 2)) -;; (make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure)) +;; (make-AssignImmediate 'argcount (make-Const 2)) +;; (make-AssignPrimOp 'val (make-ApplyPrimitiveProcedure)) ;; 'done)) ;; "7") @@ -175,50 +175,50 @@ ;; A do-nothing closure -(test (E-many (list (make-GotoStatement (make-Label 'afterLambda)) +(test (E-many (list (make-Goto (make-Label 'afterLambda)) 'closureStart - (make-GotoStatement (make-Label 'afterLambda)) + (make-Goto (make-Label 'afterLambda)) 'afterLambda - (make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0 '() 'closureStart))) + (make-AssignPrimOp 'val (make-MakeCompiledProcedure 'closureStart 0 '() 'closureStart))) "M.val.displayName") "closureStart") ;; A do-nothing closure with a few values -(test (E-many (list (make-GotoStatement (make-Label 'afterLambda)) +(test (E-many (list (make-Goto (make-Label 'afterLambda)) 'closureStart - (make-GotoStatement (make-Label 'afterLambda)) + (make-Goto (make-Label 'afterLambda)) 'afterLambda (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + (make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - (make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0 + (make-AssignPrimOp 'val (make-MakeCompiledProcedure 'closureStart 0 (list 0 1) 'closureStart))) "M.val.closedVals[1] + ',' + M.val.closedVals[0]") "hello,world") ;; Let's try to install the closure values. -(test (E-many (list (make-GotoStatement (make-Label 'afterLambdaBody)) +(test (E-many (list (make-Goto (make-Label 'afterLambdaBody)) 'closureStart - (make-PerformStatement (make-InstallClosureValues!)) - (make-GotoStatement (make-Label 'theEnd)) + (make-Perform (make-InstallClosureValues!)) + (make-Goto (make-Label 'theEnd)) 'afterLambdaBody (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + (make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 0 + (make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'closureStart 0 (list 0 1) 'closureStart)) (make-PopEnvironment (make-Const 2) (make-Const 0)) - (make-GotoStatement (make-Label 'closureStart)) + (make-Goto (make-Label 'closureStart)) 'theEnd) "plt.runtime.toWrittenString(M.env.length) + ',' + M.env[1] + ',' + M.env[0]") "2,hello,world") @@ -226,69 +226,69 @@ ;; get-compiled-procedure-entry -(test (E-many (list (make-GotoStatement (make-Label 'afterLambdaBody)) +(test (E-many (list (make-Goto (make-Label 'afterLambdaBody)) 'closureStart - (make-PerformStatement (make-InstallClosureValues!)) - (make-GotoStatement (make-Label 'theEnd)) + (make-Perform (make-InstallClosureValues!)) + (make-Goto (make-Label 'theEnd)) 'afterLambdaBody (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + (make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 0 + (make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'closureStart 0 (list 0 1) 'closureStart)) (make-PopEnvironment (make-Const 2) (make-Const 0)) - (make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) + (make-AssignPrimOp 'val (make-GetCompiledProcedureEntry)) 'theEnd) "typeof(M.val) + ',' + (M.val === M.proc.label)") "function,true") ;; check-closure-arity. This should succeed. -(void (E-many (list (make-GotoStatement (make-Label 'afterLambdaBody)) +(void (E-many (list (make-Goto (make-Label 'afterLambdaBody)) 'closureStart - (make-PerformStatement (make-InstallClosureValues!)) - (make-GotoStatement (make-Label 'theEnd)) + (make-Perform (make-InstallClosureValues!)) + (make-Goto (make-Label 'theEnd)) 'afterLambdaBody (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + (make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5 + (make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'closureStart 5 (list 0 1) 'closureStart)) (make-PopEnvironment (make-Const 2) (make-Const 0)) - (make-PerformStatement (make-CheckClosureAndArity! (make-Const 5))) + (make-Perform (make-CheckClosureAndArity! (make-Const 5))) 'theEnd))) ;; this should fail, since the check is for 1, but the closure expects 5. (let/ec return (with-handlers ([void (lambda (exn) (return))]) - (E-many (list (make-GotoStatement (make-Label 'afterLambdaBody)) + (E-many (list (make-Goto (make-Label 'afterLambdaBody)) 'closureStart - (make-PerformStatement (make-InstallClosureValues!)) - (make-GotoStatement (make-Label 'theEnd)) + (make-Perform (make-InstallClosureValues!)) + (make-Goto (make-Label 'theEnd)) 'afterLambdaBody (make-PushEnvironment 2 #f) - (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + (make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + (make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5 + (make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'closureStart 5 (list 0 1) 'closureStart)) (make-PopEnvironment (make-Const 2) (make-Const 0)) - (make-PerformStatement (make-CheckClosureAndArity! (make-Const 1))) + (make-Perform (make-CheckClosureAndArity! (make-Const 1))) 'theEnd))) (error 'expected-failure)) @@ -296,74 +296,74 @@ -(test (E-many `(,(make-AssignImmediateStatement 'val (make-Const 42)) - ,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) 'onFalse) - ,(make-AssignImmediateStatement 'val (make-Const 'ok)) - ,(make-GotoStatement (make-Label 'end)) +(test (E-many `(,(make-AssignImmediate 'val (make-Const 42)) + ,(make-TestAndJump (make-TestFalse (make-Reg 'val)) 'onFalse) + ,(make-AssignImmediate 'val (make-Const 'ok)) + ,(make-Goto (make-Label 'end)) onFalse - ,(make-AssignImmediateStatement 'val (make-Const 'not-ok)) + ,(make-AssignImmediate 'val (make-Const 'not-ok)) end)) "ok") ;; TestAndBranch: try the false branch -(test (E-many `(,(make-AssignImmediateStatement 'val (make-Const #f)) - ,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) 'onFalse) - ,(make-AssignImmediateStatement 'val (make-Const 'not-ok)) - ,(make-GotoStatement (make-Label 'end)) +(test (E-many `(,(make-AssignImmediate 'val (make-Const #f)) + ,(make-TestAndJump (make-TestFalse (make-Reg 'val)) 'onFalse) + ,(make-AssignImmediate 'val (make-Const 'not-ok)) + ,(make-Goto (make-Label 'end)) onFalse - ,(make-AssignImmediateStatement 'val (make-Const 'ok)) + ,(make-AssignImmediate 'val (make-Const 'ok)) end)) "ok") ;; ;; Test for primitive procedure -;; (test (E-many `(,(make-AssignImmediateStatement 'val (make-Const '+)) -;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) -;; ,(make-AssignImmediateStatement 'val (make-Const 'ok)) -;; ,(make-GotoStatement (make-Label 'end)) +;; (test (E-many `(,(make-AssignImmediate 'val (make-Const '+)) +;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) +;; ,(make-AssignImmediate 'val (make-Const 'ok)) +;; ,(make-Goto (make-Label 'end)) ;; onTrue -;; ,(make-AssignImmediateStatement 'val (make-Const 'not-ok)) +;; ,(make-AssignImmediate 'val (make-Const 'not-ok)) ;; end)) ;; "ok") ;; ;; Give a primitive procedure in val -;; (test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) -;; ,(make-AssignImmediateStatement 'val (make-EnvPrefixReference 0 0)) -;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) -;; ,(make-AssignImmediateStatement 'val (make-Const 'not-ok)) -;; ,(make-GotoStatement (make-Label 'end)) +;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+))) +;; ,(make-AssignImmediate 'val (make-EnvPrefixReference 0 0)) +;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) +;; ,(make-AssignImmediate 'val (make-Const 'not-ok)) +;; ,(make-Goto (make-Label 'end)) ;; onTrue -;; ,(make-AssignImmediateStatement 'val (make-Const 'ok)) +;; ,(make-AssignImmediate 'val (make-Const 'ok)) ;; end)) ;; "ok") ;; ;; Give a primitive procedure in proc, but test val -;; (test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) -;; ,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0)) -;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) -;; ,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure)) -;; ,(make-GotoStatement (make-Label 'end)) +;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+))) +;; ,(make-AssignImmediate 'proc (make-EnvPrefixReference 0 0)) +;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue) +;; ,(make-AssignImmediate 'val (make-Const 'not-a-procedure)) +;; ,(make-Goto (make-Label 'end)) ;; onTrue -;; ,(make-AssignImmediateStatement 'val (make-Const 'a-procedure)) +;; ,(make-AssignImmediate 'val (make-Const 'a-procedure)) ;; end)) ;; "not-a-procedure") ;; ;; Give a primitive procedure in proc and test proc -;; (test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+))) -;; ,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0)) -;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue) -;; ,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure)) -;; ,(make-GotoStatement (make-Label 'end)) +;; (test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(+))) +;; ,(make-AssignImmediate 'proc (make-EnvPrefixReference 0 0)) +;; ,(make-TestAndJump (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue) +;; ,(make-AssignImmediate 'val (make-Const 'not-a-procedure)) +;; ,(make-Goto (make-Label 'end)) ;; onTrue -;; ,(make-AssignImmediateStatement 'val (make-Const 'a-procedure)) +;; ,(make-AssignImmediate 'val (make-Const 'a-procedure)) ;; end)) ;; "a-procedure") ;; Set-toplevel -(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(advisor))) - ,(make-AssignImmediateStatement 'val (make-Const "Kathi")) - ,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))) +(test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(advisor))) + ,(make-AssignImmediate 'val (make-Const "Kathi")) + ,(make-AssignImmediate (make-EnvPrefixReference 0 0) (make-Reg 'val))) "M.env[0][0]") "Kathi") @@ -372,38 +372,38 @@ (let/ec return (let ([dont-care (with-handlers ([void (lambda (exn) (return))]) - (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable))) - ,(make-PerformStatement (make-CheckToplevelBound! 0 0)))))]) + (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(some-variable))) + ,(make-Perform (make-CheckToplevelBound! 0 0)))))]) (raise "I expected an error"))) ;; check-toplevel-bound shouldn't fail here. -(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(another-advisor))) - ,(make-AssignImmediateStatement 'val (make-Const "Shriram")) - ,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val)) - ,(make-PerformStatement (make-CheckToplevelBound! 0 0))) +(test (E-many `(,(make-Perform (make-ExtendEnvironment/Prefix! '(another-advisor))) + ,(make-AssignImmediate 'val (make-Const "Shriram")) + ,(make-AssignImmediate (make-EnvPrefixReference 0 0) (make-Reg 'val)) + ,(make-Perform (make-CheckToplevelBound! 0 0))) "M.env[0][0]") "Shriram") (test (E-many `(,(make-PushEnvironment 1 #f) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const '(1 2 3))) - ,(make-AssignImmediateStatement 'argcount (make-Const 1)) - ,(make-PerformStatement (make-SpliceListIntoStack! (make-Const 0)))) + ,(make-AssignImmediate 'argcount (make-Const 1)) + ,(make-Perform (make-SpliceListIntoStack! (make-Const 0)))) "M.argcount + ',' + M.env[0] + ',' + M.env[1] + ',' + M.env[2]") "3,3,2,1") (test (E-many `(,(make-PushEnvironment 3 #f) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 2 #f) (make-Const '(1 2 3))) - ,(make-AssignImmediateStatement 'argcount (make-Const 3)) - ,(make-PerformStatement (make-SpliceListIntoStack! (make-Const 2)))) + ,(make-AssignImmediate 'argcount (make-Const 3)) + ,(make-Perform (make-SpliceListIntoStack! (make-Const 2)))) "M.argcount + ',' + M.env[0] + ',' + M.env[1] + ',' + M.env[2] + ',' + M.env[3] + ',' + M.env[4]") "5,3,2,1,world,hello") @@ -415,10 +415,10 @@ ;; testing rest splicing (test (E-many `(,(make-PushEnvironment 1 #f) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - ,(make-AssignImmediateStatement 'argcount (make-Const 1)) - ,(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 0) + ,(make-AssignImmediate 'argcount (make-Const 1)) + ,(make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Const 1)))) "M.argcount + ',' + plt.runtime.isList(M.env[0])") "1,true") @@ -426,18 +426,18 @@ (test (E-many `(,(make-PushEnvironment 5 #f) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 0 #f) (make-Const "hello")) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 1 #f) (make-Const "world")) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 2 #f) (make-Const 'x)) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 3 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 3 #f) (make-Const 'y)) - ,(make-AssignImmediateStatement (make-EnvLexicalReference 4 #f) + ,(make-AssignImmediate (make-EnvLexicalReference 4 #f) (make-Const 'z)) - ,(make-AssignImmediateStatement 'argcount (make-Const 5)) - ,(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 2) (make-Const 3)))) + ,(make-AssignImmediate 'argcount (make-Const 5)) + ,(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]") "3,3,true,hello,world") @@ -446,16 +446,16 @@ ;; Check closure mismatch. Make sure we're getting the right values from the test. (test (E-many `(procedure-entry ;; doesn't matter about the procedure entry... - ,(make-AssignPrimOpStatement + ,(make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry)) - ,(make-TestAndJumpStatement + ,(make-TestAndJump (make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 0)) 'bad) - ,(make-AssignImmediateStatement 'val (make-Const 'ok)) - ,(make-GotoStatement (make-Label 'end)) + ,(make-AssignImmediate 'val (make-Const 'ok)) + ,(make-Goto (make-Label 'end)) bad - ,(make-AssignImmediateStatement 'val (make-Const 'bad)) + ,(make-AssignImmediate 'val (make-Const 'bad)) end) "M.val") "ok") @@ -463,48 +463,48 @@ (test (E-many `(procedure-entry ;; doesn't matter about the procedure entry... - ,(make-AssignPrimOpStatement + ,(make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry)) - ,(make-TestAndJumpStatement + ,(make-TestAndJump (make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 1)) 'ok) - ,(make-AssignImmediateStatement 'val (make-Const 'bad)) - ,(make-GotoStatement (make-Label 'end)) + ,(make-AssignImmediate 'val (make-Const 'bad)) + ,(make-Goto (make-Label 'end)) ok - ,(make-AssignImmediateStatement 'val (make-Const 'ok)) + ,(make-AssignImmediate 'val (make-Const 'ok)) end) "M.val") "ok") (test (E-many `(procedure-entry ;; doesn't matter about the procedure entry... - ,(make-AssignPrimOpStatement + ,(make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list) 'procedure-entry)) - ,(make-TestAndJumpStatement + ,(make-TestAndJump (make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 0)) 'ok) - ,(make-AssignImmediateStatement 'val (make-Const 'bad)) - ,(make-GotoStatement (make-Label 'end)) + ,(make-AssignImmediate 'val (make-Const 'bad)) + ,(make-Goto (make-Label 'end)) ok - ,(make-AssignImmediateStatement 'val (make-Const 'ok)) + ,(make-AssignImmediate 'val (make-Const 'ok)) end) "M.val") "ok") (test (E-many `(procedure-entry ;; doesn't matter about the procedure entry... - ,(make-AssignPrimOpStatement + ,(make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list) 'procedure-entry)) - ,(make-TestAndJumpStatement + ,(make-TestAndJump (make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 2)) 'bad) - ,(make-AssignImmediateStatement 'val (make-Const 'ok)) - ,(make-GotoStatement (make-Label 'end)) + ,(make-AssignImmediate 'val (make-Const 'ok)) + ,(make-Goto (make-Label 'end)) bad - ,(make-AssignImmediateStatement 'val (make-Const 'bad)) + ,(make-AssignImmediate 'val (make-Const 'bad)) end) "M.val") "ok") @@ -517,10 +517,10 @@ ,(make-PushImmediateOntoEnvironment (make-Const 4) #f) procedure-entry ;; doesn't matter about the procedure entry... - ,(make-AssignPrimOpStatement + ,(make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry)) - ,(make-AssignImmediateStatement 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 0))) + ,(make-AssignImmediate 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 0))) "M.val") "4") @@ -528,10 +528,10 @@ ,(make-PushImmediateOntoEnvironment (make-Const 4) #f) procedure-entry ;; doesn't matter about the procedure entry... - ,(make-AssignPrimOpStatement + ,(make-AssignPrimOp 'proc (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry)) - ,(make-AssignImmediateStatement 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 1))) + ,(make-AssignImmediate 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 1))) "M.val") "3") diff --git a/tests/test-parse-bytecode.rkt b/tests/test-parse-bytecode.rkt index f582a1a..6fb3917 100644 --- a/tests/test-parse-bytecode.rkt +++ b/tests/test-parse-bytecode.rkt @@ -227,19 +227,20 @@ ;; the letrec gets translated into a closure call -(begin - (reset-lam-label-counter!/unit-testing) - (check-equal? (run-my-parse '(letrec ([omega (lambda () (omega))]) - (omega))) - (make-Top (make-Prefix '()) - (make-App (make-Lam 'omega 0 #f (make-App (make-EmptyClosureReference 'omega 0 #f 'lamEntry1) '()) - '() 'lamEntry1) - '())))) +(check-true (match (run-my-parse '(letrec ([omega (lambda () (omega))]) + (omega))) + [(struct Top ((struct Prefix (list)) + (struct App ((struct Lam ('omega 0 + #f + (struct App ((struct EmptyClosureReference ('omega 0 #f _)) + (list))) + (list) _)) + (list))))) + #t])) ;; FIXME: make this a real test. (begin - (reset-lam-label-counter!/unit-testing) (void (run-my-parse #'(letrec ([e (lambda (y) (if (= y 0) #t @@ -292,14 +293,12 @@ (make-App (make-PrimitiveKernelValue 'current-continuation-marks) '())))) -(begin (reset-lam-label-counter!/unit-testing) - (check-true (match (run-my-parse #'(case-lambda)) +(begin (check-true (match (run-my-parse #'(case-lambda)) [(struct Top ((struct Prefix (list)) - (struct CaseLam (_ (list) 'lamEntry1)))) + (struct CaseLam (_ (list) _)))) #t]))) -(begin (reset-lam-label-counter!/unit-testing) - (check-true (match (run-my-parse #'(case-lambda [(x) x] +(begin (check-true (match (run-my-parse #'(case-lambda [(x) x] [(x y) x] [(x y) y])) [(struct Top ((struct Prefix (list)) @@ -309,20 +308,20 @@ #f (struct LocalRef ('0 '#f)) '() - 'lamEntry2)) + _)) (struct Lam (_ 2 #f (struct LocalRef ('0 '#f)) '() - 'lamEntry3)) + _)) (struct Lam (_ 2 #f (struct LocalRef ('1 '#f)) '() - 'lamEntry4))) - 'lamEntry1)))) + _))) + _)))) #t]))) diff --git a/tests/test-parse.rkt b/tests/test-parse.rkt index 210e8ad..658bd6e 100644 --- a/tests/test-parse.rkt +++ b/tests/test-parse.rkt @@ -1,7 +1,6 @@ #lang racket/base (require "../parser/baby-parser.rkt" - "../parser/lam-entry-gensym.rkt" "../compiler/lexical-structs.rkt" "../compiler/expression-structs.rkt" (for-syntax racket/base)) @@ -16,7 +15,6 @@ (syntax/loc #'stx (begin (printf "Running ~s ...\n" (syntax->datum #'expr)) - (reset-lam-label-counter!/unit-testing) (let ([expected expt] [actual (with-handlers ([void @@ -25,8 +23,8 @@ #'stx))]) expr)]) (unless (equal? actual expected) - (raise-syntax-error #f (format "Expected ~s, got ~s" expected actual) - #'stx)) + (printf (format "Expected ~s, got ~s, at ~s" expected actual + (syntax-line #'stx)))) (printf "ok.\n\n")))))]))