#lang scheme

(require (planet schematics/schemeunit:2:10/test)
         "checks.ss"
         "../syntax.ss")

(provide test-syntax)

(define test-syntax
  (test-suite "syntax.ss"
    (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-map"
      (test-case "identifiers to symbols"
        (check-equal? (syntax-map syntax-e #'(a b c)) '(a b c))))
    (test-suite "to-syntax"
      (test-case "symbol + context = identifier"
        (check bound-identifier=?
               (to-syntax #:stx #'here 'id)
               #'id)))
    (test-suite "to-datum"
      (test-case "nested syntax"
        (check-equal? (to-datum (list #'(a b) #'() #'(c))) '((a b) () (c)))))
    (test-suite "with-syntax*"
      (test-case "identifier"
        (check bound-identifier=?
               (with-syntax* ([a #'id] [b #'a]) #'b)
               #'id)))))