(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"
"../../config.ss")
(define test-ns (make-javascript-namespace))
(enable-let-expressions? #t)
(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 prototype-tests
(test-suite "prototype tests"
(test-case "global object toString"
(before
(reset-javascript-namespace! test-ns)
(check-equal? (eval-javascript-string "this.toString()" test-ns) "[object DrScheme]")))
(test-case "vanilla object toString"
(before
(reset-javascript-namespace! test-ns)
(check-equal? (eval-javascript-string "({}).toString()" test-ns) "[object Object]")))
(test-case "dot method call sets up current this"
(check-output '("true")
"({foo:function(){print(this.bar)},bar:true}).foo()"))
(test-case "eval maintains current this"
(check-output '("true")
"({foo:function(){eval('print(this.bar)')},bar:true}).foo()"))
(test-case "eval gets same namespace"
(check-output '("true")
"var a = true;"
"eval('print(this.a)');"))
))
(define library-tests
(test-suite "library tests"
(test-case "String called as a function"
(before
(reset-javascript-namespace! test-ns)
(check-equal? (eval-javascript-string "String(44)" test-ns) "44")))
(test-case "Number called as a function"
(before
(reset-javascript-namespace! test-ns)
(check-equal? (eval-javascript-string "Number('44')" test-ns) 44)))
(test-case "Boolean called as a function"
(before
(reset-javascript-namespace! test-ns)
(check-equal? (eval-javascript-string "Boolean(0)" test-ns) 'false)))
(test-case "String.fromCharCode"
(before
(reset-javascript-namespace! test-ns)
(check-equal? (eval-javascript-string "String.fromCharCode(104,101,108,108,111)" test-ns) "hello")))
(test-case "Array with 0 args"
(check-output '("")
"var a = new Array(); print(a)"))
(test-case "Array with 1 arg - number"
(check-output '(",,,,")
"var a = new Array(5); print(a)"))
(test-case "Array with 1 arg - non-number"
(check-output '("true")
"var a = new Array(true); print(a)"))
(test-case "Array with two args"
(check-output '("1,2")
"var a = new Array(1,2); print(a)"))
(test-case "Array with three args"
(check-output '("1,2,3")
"var a = new Array(1,2,3); print(a)"))
))
(define eval-tests
(test-suite "eval tests"
binding-tests
prototype-tests
library-tests
))
(provide eval-tests))