(module test mzscheme (require "require.ss" "syntax-utils.ss" (lib "contract.ss")) (require-schemeunit) (require-contract-utils) (test/graphical-ui (test-suite "syntax-utils.plt" (test-suite "syntax-datum/c" (test-case "non-syntax" (check-false ((predicate-of (syntax-datum/c any/c)) 'symbol))) (test-case "bad syntax" (check-false ((predicate-of (syntax-datum/c number?)) (syntax identifier)))) (test-case "good syntax" (check-true ((predicate-of (syntax-datum/c (listof (listof number?)))) (syntax ((1 2 3) (4 5) (6))))))) (test-suite "syntax-list/c" (test-case "non-syntax" (check-false ((predicate-of (syntax-list/c any/c)) 'symbol))) (test-case "non-list syntax" (check-false ((predicate-of (syntax-list/c any/c)) (syntax identifier)))) (test-case "bad syntax list" (check-false ((predicate-of (syntax-list/c identifier?)) (syntax (1 2 3 4))))) (test-case "good syntax list" (check-true ((predicate-of (syntax-list/c identifier?)) (syntax (a b c d)))))) (test-suite "identifier-name=?" (test-case "reflexivity" (check-true (identifier-name=? (syntax name) (syntax name)))) (test-case "inequality" (check-false (identifier-name=? (syntax one) (syntax two))))) (test-case "syntax-map" (check-equal? (syntax-map syntax-e (syntax (a b c d))) (quote (a b c d)))) (test-case "syntax-append" (check-eq? (syntax-e (syntax-append "prefix" (syntax -) "suffix")) 'prefix-suffix)) (test-case "syntax-prefix" (check-eq? (syntax-e (syntax-prefix "prefix-" (syntax suffix))) 'prefix-suffix)) (test-case "syntax-suffix" (check-eq? (syntax-e (syntax-suffix (syntax prefix) "-suffix")) 'prefix-suffix)) (test-suite "string->identifier" (test-case "no context" (check-eq? (syntax-e (string->identifier "name")) 'name)) (test-case "empty context" (check-eq? (syntax-e (string->identifier "name" #f)) 'name)) (test-case "with context" (check-eq? (syntax-e (string->identifier "name" (syntax id))) 'name))) (test-case "identifier->string" (check-equal? (identifier->string (syntax name)) "name")) (test-case "identifier->string-literal" (check-equal? (syntax-e (identifier->string-literal (syntax name))) "name")) (test-suite "syntax-source-module-name" (test-case "w/ source" (check-pred symbol? (syntax-source-module-name #'here))) (test-case "w/o source" (check-pred symbol? (syntax-source-module-name (datum->syntax-object #f 'here #f #f #f))))))) )