(module parse 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))
           (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-check (check-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-check (check-tokens str expected)
    (check-tokenized str (string->tokens str) expected))

  (define-simple-check (check-parsed str actual expected)
    (equal? actual expected))

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

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

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

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

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

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

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

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

  (provide parse-tests))