(module eval mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2 1))
(planet "test.ss" ("dherman" "test.plt" 1 2))
(planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2 1))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 1))
(planet "io.ss" ("dherman" "io.plt" 1 6))
(lib "string.ss" "srfi" "13")
(lib "string.ss")
"../../eval.ss")
(define test-ns (make-javascript-namespace))
(define-simple-check (check-output* expected lines)
(reset-javascript-namespace! test-ns)
(let ([actual (with-output-to-string (eval-javascript-string (string-join lines "\n") test-ns))])
(andmap string=?
expected
(regexp-split #rx"[\r\n]+" (string-trim-both actual)))))
(define-syntax check-output
(syntax-rules ()
[(_ expected lines ...)
(check-output* expected (list lines ...))]))
(define binding-tests
(test-suite "binding tests"
(test-case "top-level binding"
(check-output '("true")
"var a = true;"
"print(a);"))
(test-case "non-with lexical binding"
(check-output '("true")
"(function(a){print(a)})(true)"))
(test-case "non-with catch binding"
(check-output '("true")
"try{throw true}catch(a){print(a)}"))
(test-case "non-with let binding"
(check-output '("true")
"let (a = true){print(a)}"))
(test-case "non-with lexical shadowing of top-level"
(check-output '("true")
"var a = false;"
"(function(a){print(a)})(true);"))
(test-case "non-with lexical shadowing of lexical"
(check-output '("true")
"(function(a){(function(a){print(a)})(true)})(false);"))
(test-case "non-with lexical shadowing of catch"
(check-output '("true")
"try{throw false}catch(a){(function(a){print(a)})(true)}"))
(test-case "non-with lexical shadowing of let"
(check-output '("true")
"let (a = false){(function(a){print(a)})(true)}"))
(test-case "non-with catch shadowing of top-level"
(check-output '("true")
"var a = false"
"try{throw true}catch(a){print(a)}"))
(test-case "non-with catch shadowing of lexical"
(check-output '("true")
"(function(a){try{throw true}catch(a){print(a)}})(false)"))
(test-case "non-with catch shadowing of catch"
(check-output '("true")
"try{throw false}catch(a){try{throw true}catch(a){print(a)}}"))
(test-case "non-with catch shadowing of let"
(check-output '("true")
"let (a = false){try{throw true}catch(a){print(a)}}"))
(test-case "non-with let shadowing of top-level"
(check-output '("true")
))
(test-case "non-with let shadowing of lexical"
(check-output '("true")
))
(test-case "non-with let shadowing of catch"
(check-output '("true")
))
(test-case "non-with let shadowing of let"
(check-output '("true")
))
(test-case "with binding"
(check-output '("true")
"var o = {a:true}"
"with(o){print(a)}"))
(test-case "with shadowing of top-level"
(check-output '("true")
"var o = {a:true}"
"var a = false"
"with(o){print(a)}"))
(test-case "with shadowing of lexical"
(check-output '("true")
"var o = {a:true};"
"(function(a){with(o){print(a)}})(false);"))
(test-case "with shadowing of with"
(check-output '("true")
"var o1 = {a:false};"
"var o2 = {a:true};"
"with(o1){with(o2){print(a)}}"))
(test-case "with shadowing of catch"
(check-output '("true")
"var o = {a:true}"
"try{throw false}catch(a){with(o){print(a)}}"))
(test-case "with shadowing of let"
(check-output '("true")
))
(test-case "lexical shadowing of with"
(check-output '("true")
"var o = {a:false}"
"with(o) {(function(a){print(a)})(true)}"))
(test-case "catch shadowing of with"
(check-output '("true")
"var o = {a:false}"
"with(o){try{throw true}catch(a){print(a)}}"))
(test-case "let shadowing of with"
(check-output '("true")
))
(test-case "with shadowing of lexical shadowing of with"
(check-output '("true")
"var o1 = {a:1}"
"var o2 = {a:true}"
"with(o1){(function(a){with(o2){print(a)}})(2)}"))
(test-case "with shadowing of catch shadowing of with"
(check-output '("true")
"var o1 = {a:1}"
"var o2 = {a:true}"
"with(o1){try{throw 2}catch(a){with(o2){print(a)}}}"))
(test-case "with shadowing of let shadowing of with"
(check-output '("true")
))
(test-case "with shadowing of catch shadowing of lexical"
(check-output '("true")
"var o = {a:true};"
"(function(a){try{throw 1}catch(a){with(o){print(a)}}})(2)"))
(test-case "lexical shadowing of catch shadowing of with"
(check-output '("true")
"var o = {a:1};"
"try{throw 2}catch(a){(function(a){print(a)})(true)}"))
(test-case "with shadowing of catch shadowing of let"
(check-output '("true")
))
(test-case "lexical shadowing of with shadowing of catch"
(check-output '("true")
"var o = {a:1};"
"try{throw 2}catch(a){with(o){(function(a){print(a)})(true)}}"))
(test-case "catch shadowing of with shadowing of lexical"
(check-output '("true")
"var o = {a:1};"
"(function(a){with(o){try{throw true}catch(a){print(a)}}})(2);"))
(test-case "let shadowing of with shadowing of catch"
(check-output '("true")
))
(test-case "let shadowing of with shadowing of lexical"
(check-output '("true")
))
(test-case "lexical shadowing of with shadowing of let"
(check-output '("true")
))
(test-case "catch shadowing of with shadowing of let"
(check-output '("true")
))
(test-case "with shadowing of lexical shadowing of catch"
(check-output '("true")
"var o = {a:true};"
"try{throw 1}catch(a){(function(a){with(o){print(a)}})(2)}"))
(test-case "with shadowing of lexical shadowing of let"
(check-output '("true")
))
(test-case "catch shadowing of lexical shadowing of with"
(check-output '("true")
"var o = {a:1};"
"with(o){(function(a){try{throw true}catch(a){print(a)}})(2)}"))
(test-case "let shadowing of lexical shadowing of with"
(check-output '("true")
))
(test-case "mutation of with-bound variable"
(check-output '("true")
"var o = {a:false}"
"with(o) {o.a=true;print(a)}"))
(test-case "temporary with shadowing of top-level"
(check-output '("true")
"var a = true;"
"var o = {a:false}"
"with(o) {delete o.a;print(a)}"))
(test-case "temporary with shadowing of lexical"
(check-output '("true")
"var o = {a:false};"
"(function(a){with(o){delete o.a;print(a)}})(true);"))
(test-case "temporary with shadowing of with"
(check-output '("true")
"var o1 = {a:true};"
"var o2 = {a:false};"
"with(o1){with(o2){delete o2.a;print(a)}}"))
(test-case "temporary with shadowing of catch"
(check-output '("true")
"var o = {a:false};"
"try{throw true}catch(a){with(o){delete o.a;print(a)}}"))
(test-case "temporary with shadowing of let"
(check-output '("true")
))
(test-case "lexical shadowing of temporary with"
(check-output '("true")
"var o = {a:false};"
"with(o){(function(a){delete o.a;print(a)})(true)}"))
(test-case "catch shadowing of temporary with"
(check-output '("true")
"var o = {a:false};"
"with(o){try{throw true}catch(a){delete o.a;print(a)}}"))
(test-case "let shadowing of temporary with"
(check-output '("true")
))
(test-case "temporary with shadowing of lexical shadowing of with"
(check-output '("true")
"var o1 = {a:1};"
"var o2 = {a:2};"
"with(o1){(function(a){with(o2){delete o2.a;print(a)}})(true)}"))
(test-case "temporary with shadowing of catch shadowing of with"
(check-output '("true")
"var o1 = {a:1};"
"var o2 = {a:2};"
"with(o1){try{throw true}catch(a){with(o2){delete o2.a;print(a)}}}"))
))
(define eval-tests
(test-suite "eval tests"
binding-tests
))
(provide eval-tests))