#lang scheme

(require "checks.ss"
         "../syntax.ss")

(provide test-syntax)

(define test-syntax
  (test-suite "syntax.ss"

    (test-suite "Contracts"

      (test-suite "syntax-datum/c"
        (test-case "accept"
          (check-contract-accept
           (syntax-datum/c (listof (listof natural-number/c)))
           #'((0 1 2) () (3 4) (5))))
        (test-case "reject ill-formed syntax"
          (check-contract-reject
           (syntax-datum/c (listof (listof natural-number/c)))
           #'((x y z))))
        (test-case "reject non-syntax"
          (check-contract-reject (syntax-datum/c string?) "xyz")))

      (test-suite "syntax-listof/c"
        (test-case "accept"
          (check-contract-accept (syntax-listof/c identifier?) #'(a b c)))
        (test-case "reject ill-formed element"
          (check-contract-reject (syntax-listof/c identifier?) #'(1 2 3)))
        (test-case "reject improper list"
          (check-contract-reject (syntax-listof/c identifier?) #'(a b . c)))
        (test-case "reject non-syntax"
          (check-contract-reject (syntax-listof/c identifier?) '(#'a #'b #'c))))

      (test-suite "syntax-list/c"
        (test-case "accept"
          (check-contract-accept
           (syntax-list/c identifier? (syntax/c string?))
           #'(a "b")))
        (test-case "reject extra element"
          (check-contract-reject
           (syntax-list/c identifier? (syntax/c string?))
           #'(a "b" #:c)))
        (test-case "reject ill-formed element"
          (check-contract-reject
           (syntax-list/c identifier? (syntax/c string?))
           #'(a b)))
        (test-case "reject improper list"
          (check-contract-reject
           (syntax-list/c identifier? (syntax/c string?))
           #'(a "b" . c)))
        (test-case "reject non-syntax"
          (check-contract-reject
           (syntax-list/c identifier? (syntax/c string?))
           '(#'a #'"b")))))

    (test-suite "Syntax Lists"

      (test-suite "syntax-map"
        (test-case "identifiers to symbols"
          (check-equal? (syntax-map syntax-e #'(a b c)) '(a b c)))))

    (test-suite "Syntax Conversions"

      (test-suite "to-syntax"
        (test-case "symbol + context = identifier"
          (check bound-identifier=?
                 (to-syntax #:stx #'here 'id)
                 #'id)))

      (test-suite "to-datum"
        (test-case "syntax"
          (check-equal? (to-datum #'((a b) () (c)))
                        '((a b) () (c))))
        (test-case "non-syntax"
          (check-equal? (to-datum '((a b) () (c)))
                        '((a b) () (c))))
        (test-case "nested syntax"
          (let* ([stx-ab #'(a b)]
                 [stx-null #'()]
                 [stx-c #'(c)])
            (check-equal? (to-datum (list stx-ab stx-null stx-c))
                          (list stx-ab stx-null stx-c))))))

    (test-suite "Pattern Bindings"

      (test-suite "with-syntax*"
        (test-case "identifier"
          (check bound-identifier=?
                 (with-syntax* ([a #'id] [b #'a]) #'b)
                 #'id))))))