(module xxexpr-test mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require "xxexpr.ss")
(provide xxexpr-tests)
(define xxexpr-tests
(make-test-suite
"All tests for xxexpr"
(make-test-case
"xml-empty-tags-mode toggles empty tag printing"
(parameterize
((xml-empty-tags-mode #t))
(assert string=?
(xxexpr->string '((p)))
"<p/>"))
(parameterize
((xml-empty-tags-mode #f))
(assert string=?
(xxexpr->string '((p)))
"<p></p>")))
(make-test-case
"xml-double-quotes-mode toggles quotes in attribute printing"
(parameterize
((xml-double-quotes-mode #t))
(assert string=?
(xxexpr->string '((p (@ (class "foo")) "Text")))
"<p class=\"foo\">Text</p>"))
(parameterize
((xml-double-quotes-mode #f))
(assert string=?
(xxexpr->string '((p (@ (class "foo")) "Text")))
"<p class='foo'>Text</p>")))
(make-test-case
"xxexpr->string/notags"
(assert string=?
(xxexpr->string/notags '((p (@ (class "foo")) "Text")))
"Text"))
(make-test-case
"write-xxexpr returns #t"
(assert-true (write-xxexpr '((p (@ (class "foo")) "Text")))))
(make-test-case
"write-xxexpr outputs SXML to given port"
(let ((port (open-output-string)))
(write-xxexpr '((p (@ (class "foo")) "Text")) port)
(assert string=?
"<p class='foo'>Text</p>"
(get-output-string port))))
(make-test-case
"write-xxexpr/notags outputs SXML to given port, skipping tags"
(let ((port (open-output-string)))
(assert-true (write-xxexpr/notags
'((p (@ (class "foo")) "Text"))
port))
(assert string=?
"Text"
(get-output-string port))))
))
)