(module parse mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
           (planet "test.ss" ("dherman" "test.plt" 1 2))
           (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 1 1))
           (lib "class.ss")
           (lib "etc.ss")
           "../../syntax/ast.ss"
           "../../syntax/parse.ss"
           "../../syntax/sexp.ss"
           "../../syntax/token.ss"
           "../../syntax/tokenize.ss")

  ;; TODO: unit tests for:
  ;;   - empty case clause
  ;;   - one-armed if
  ;;   - label definedness check

  (define (string-tokenizer s)
    (make-object tokenizer% (open-input-string s)))

  (define (extract-tokens t n)
    (build-list n (lambda (i)
                    (send t read-token))))

  (define (string->tokens s)
    (let ([t (string-tokenizer s)])
      (let loop ([acc '()])
        (let ([token (send t read-token)])
          (if (eq? (token-type token) 'END)
              (reverse acc)
              (loop (cons token acc)))))))

  (define-simple-assertion (assert-tokenized str actual expected)
    (and (= (length actual) (length expected))
         (andmap (lambda (actual expected)
                   (if (symbol? expected)
                       (eq? (token-type actual) expected)
                       (and (eq? (token-type actual) (car expected))
                            (equal? (token-contents actual) (cdr expected)))))
                 actual
                 expected)))

  (define-assertion (assert-tokens str expected)
    (assert-tokenized str (string->tokens str) expected))

  (define-simple-assertion (assert-parsed str actual expected)
    (equal? actual expected))

  (define-assertion (assert-expression str expected)
    (assert-parsed str (Expression->sexp (parse-expression str)) expected))

  (define-assertion (assert-source-element str expected)
    (assert-parsed str (SourceElement->sexp (parse-source-element str)) expected))

  (define tokenizer-tests
    (make-test-suite
     "tokenizer tests"
     (make-test-case "identifiers"
       (assert-tokens "foo bar baz"
                      '((ID . foo) (ID . bar) (ID . baz))))
     (make-test-case "for loop"
       (assert-tokens "for (var i = 0; i < 10; i+=1) {\n    print(i)\n}"
                      '(for \( var ID ASSIGN NUMBER \; ID < NUMBER \; ID ASSIGN NUMBER \) \{ ID \( ID \) \})))
     (make-test-case "regexp with quoted forward slash"
       (assert-tokens "foo /ab\\/cd/ bar"
                      '((ID . foo) REGEXP (ID . bar))))
     (make-test-case "regexp with character classes and escapes"
       (assert-tokens "foo /^[ \\t]+/ bar"
                      '((ID . foo) REGEXP (ID . bar))))
     (make-test-case "regexp with escape"
       (assert-tokens "foo /^\\s+/ bar"
                      '((ID . foo) REGEXP (ID . bar))))
     (make-test-case "regexp stops at first forward slash"
       (assert-tokens "/abc/ : /def/"
                      '(REGEXP : REGEXP)))
     (make-test-case "bigger example of regexp stopping at first forward slash"
       (assert-tokens "(this.scanNewlines ? /^[ \\t]+/ : /^\\s+/)"
                      '(\( this \. ID ? REGEXP : REGEXP \))))
     (make-test-case "string literal (single quotes)"
       (assert-tokens "'foo'"
                      '((STRING . "foo"))))
     (make-test-case "string literal (double quotes)"
       (assert-tokens "\"foo\""
                      '((STRING . "foo"))))
     (make-test-case "string single-char escape 1"
       (assert-tokens "'foo\\nbar'"
                      '((STRING . "foo\nbar"))))
     (make-test-case "string single-char escape 2"
       (assert-tokens "'foo\\'bar'"
                      '((STRING . "foo'bar"))))
     (make-test-case "string single-char escape 3"
       (assert-tokens "'foo\\\"bar'"
                      '((STRING . "foo\"bar"))))
     (make-test-case "string hex escape"
       (assert-tokens "'foo\\x51bar'"
                      '((STRING . "fooQbar"))))
     (make-test-case "string unicode escape"
       (assert-tokens "'foo\\u0051bar'"
                      '((STRING . "fooQbar"))))
     (make-test-case "string hex non-escape 1"
       (assert-tokens "'foo\\x5qbar'"
                      '((STRING . "foox5qbar"))))
     (make-test-case "string hex non-escape 2"
       (assert-tokens "'foo\\xqqbar'"
                      '((STRING . "fooxqqbar"))))
     (make-test-case "string unicode non-escape 1"
       (assert-tokens "'foo\\u555qbar'"
                      '((STRING . "foou555qbar"))))
     (make-test-case "string unicode non-escape 2"
       (assert-tokens "'foo\\u55qqbar'"
                      '((STRING . "foou55qqbar"))))
     (make-test-case "string unicode non-escape 3"
       (assert-tokens "'foo\\u5qqqbar'"
                      '((STRING . "foou5qqqbar"))))
     (make-test-case "string unicode non-escape 4"
       (assert-tokens "'foo\\uqqqqbar'"
                      '((STRING . "foouqqqqbar"))))
     (make-test-case "string octal escape 1"
       (assert-tokens "'foo\\121bar'"
                      '((STRING . "fooQbar"))))
     (make-test-case "string octal escape 2"
       (assert-tokens "'foo\\00bar'"
                      '((STRING . "foo\0bar"))))
     (make-test-case "string null escape"
       (assert-tokens "'foo\0bar'"
                      '((STRING . "foo\0bar"))))
     ))

  (define precedence-tests
    (make-test-suite
     "precedence tests"
     (make-test-case "higher precedence between lower"
       (assert-expression "x - y * z + w"
                          '(+ (- x (* y z)) w)))
     (make-test-case "low, high, middle"
       (assert-expression "x < y * z + w"
                          '(< x (+ (* y z) w))))
     (make-test-case "big example"
       (assert-expression "x + y * z / 3 - 21 + a.b.c * 6"
                          '(+ (- (+ x (/ (* y z) 3)) 21) (* (field (field a b) c) 6))))
     (make-test-case "low followed by two high"
       (assert-expression "x + y * z * n"
                          '(+ x (* (* y z) n))))
     (make-test-case "two of same precedence"
       (assert-expression "y * z / 3"
                          '(/ (* y z) 3)))
     (make-test-case "new with arguments"
       (assert-expression "new C(2, 3)"
                          '(new C 2 3)))
     (make-test-case "new with arguments then called"
       (assert-expression "new Function('return')()"
                          '((new Function "return"))))
     ))

  (define for-tests
    (make-test-suite
     "for loop tests"
     (make-test-case "empty for loop"
       (assert-source-element "for (;;) break;"
                              '(for () #t ()
                                 (break))))
     ;; TODO: test all combinations
     (make-test-case "for-in loop"
       (assert-source-element "for (var x in e) break;"
                              '(for-in ((var x) e)
                                 (break))))
     ))

  (define misc-tests
    (make-test-suite
     "miscellaneous parse tests"
     (make-test-case "nullary function expression"
       (assert-expression "function() { return }"
                          '(function () (return))))
     (make-test-case "unary function expression"
       (assert-expression "function(x) { return }"
                          '(function (x) (return))))
     (make-test-case "binary function expression"
       (assert-expression "function(x,y) { return }"
                          '(function (x y) (return))))
     (make-test-case "ternary function expression"
       (assert-expression "function(x,y,z) { return }"
                          '(function (x y z) (return))))
     (make-test-case "empty object expression"
       (assert-expression "{ }"
                          '(object)))
     (make-test-case "unary object expression"
       (assert-expression "{ a: 2 }"
                          '(object [a 2])))
     (make-test-case "binary object expression"
       (assert-expression "{ a: 2, b: 3 }"
                          '(object [a 2] [b 3])))
     (make-test-case "ternary object expression"
       (assert-expression "{ a: 2, b: 3, c: 4 }"
                          '(object [a 2] [b 3] [c 4])))
     (make-test-case "function literal in object"
       (assert-expression "{ f: function() { return }, a: 3 }"
                          '(object [f (function () (return))]
                                   [a 3])))
     (make-test-case "nested braces"
       (assert-expression "function() { var s = {}; return }"
                          '(function ()
                             (var [s (object)])
                             (return))))
     (make-test-case "nested brackets"
       (assert-expression "[ [1, 2, 3], [4, 5, 6], [7, 8] ]"
                          '(array (array 1 2 3)
                                  (array 4 5 6)
                                  (array 7 8))))
     (make-test-case "brackets don't throw off tokenizer state"
       (assert-expression "function() { var s = []; return }"
                          '(function ()
                             (var [s (array)])
                             (return))))
     (make-test-case "var with empty array literal"
       (assert-source-element "var x = [];"
                              '(var [x (array)])))
     (make-test-case "assignment expression"
       (assert-expression "x = foo(3)"
                          '(x . = . (foo 3))))
     (make-test-case "empty switch"
       (assert-source-element "switch(x) { }"
                              '(switch x)))
     (make-test-case "case clause with multiple statements"
       (assert-source-element "switch (x) { case 1: foo(); bar(); break; case 2: break; }"
                              '(switch x
                                 (case 1
                                   (foo)
                                   (bar)
                                   (break))
                                 (case 2
                                   (break)))))
     (make-test-case "do-while loop"
       (assert-source-element "do { foo() } while (true)"
                              '(do (block (foo))
                                 #t)))
     (make-test-case "infix operators don't include unary operators 1"
       (assert-expression "2 ~ 3" 2))
     (make-test-case "infix operators don't include unary operators 2"
       (assert-expression "2 ! 3" 2))
     (make-test-case "ternary ? : is an `infix-operator-token?' 1"
       (assert-expression "x ? y : z"
                          '(? x y z)))
     (make-test-case "ternary ? : is an `infix-operator-token?' 2"
       (assert-source-element "{ s = x ? y : z }"
                              '(block (= s (? x y z)))))
     ))

  (define big-tests
    (make-test-suite
     "big example files"
     (make-test-case "example1"
       (assert-not-false (in-this-directory
                           (with-input-from-file "example1.js"
                             (lambda ()
                               (parse-script (current-input-port)))))))
     (make-test-case "example2"
       (assert-not-false (in-this-directory
                           (with-input-from-file "example2.js"
                             (lambda ()
                               (parse-script (current-input-port)))))))
     ))

  (define parse-tests
    (make-test-suite
     "parse tests"
     tokenizer-tests
     precedence-tests
     misc-tests
     for-tests
     big-tests
     ))

  (provide parse-tests))