<![CDATA[hello world[mp3]]]>

#lang racket (require rackunit rackunit/text-ui xml xml/plist mzlib/etc "to-list.rkt") ;; test-bad-read-input : format-str str -> void ;; First argument is the input, second is the error message (define ((mk-test-read-xml/exn read-xml) format-str err-string) (define str (format format-str)) (test-exn str (lambda (x) (regexp-match (regexp-quote err-string) (exn-message x))) (lambda () (read-xml (open-input-string str))))) (define test-read-xml/exn (mk-test-read-xml/exn read-xml)) (define (test-read-xml str xml #:document-different? [diff? #f]) (unless diff? (test-equal? str (document->list (read-xml/document (open-input-string str))) xml)) (test-equal? str (document->list (read-xml (open-input-string str))) xml)) (define test-syntax:read-xml/exn (mk-test-read-xml/exn syntax:read-xml)) (define (test-syntax:read-xml str xml) (test-equal? str (syntax->datum (syntax:read-xml (open-input-string str))) xml)) (define test-read-xml/element/exn (mk-test-read-xml/exn read-xml/element)) (define (test-read-xml/element str xml) (test-equal? str (element->list (read-xml/element (open-input-string str))) xml)) (define test-syntax:read-xml/element/exn (mk-test-read-xml/exn syntax:read-xml/element)) (define (test-syntax:read-xml/element str xml) (test-equal? str (syntax->datum (syntax:read-xml/element (open-input-string str))) xml)) (define (test-write-xml str) (test-equal? str (with-output-to-string (lambda () (write-xml (read-xml (open-input-string str))))) str)) (define (test-write-xml/content str) (test-equal? str (with-output-to-string (lambda () (write-xml/content (document-element (read-xml (open-input-string str)))))) str)) (define (test-display-xml str res) (test-equal? str (with-output-to-string (lambda () (display-xml (read-xml (open-input-string str))))) res)) (define (test-display-xml/content str res) (test-equal? str (with-output-to-string (lambda () (display-xml/content (document-element (read-xml (open-input-string str)))))) res)) (define (test-xexpr? xe) (test-not-false (format "~S" xe) (xexpr? xe))) (define (test-not-xexpr? xe) (test-false (format "~S" xe) (xexpr? xe))) (define (contract->predicate c) (lambda (v) (with-handlers ([exn:fail:contract? (lambda (x) #f)]) (contract c v 'pos 'neg) #t))) (define xml-tests (test-suite "XML" (test-suite "Legacy tests" (test-suite "DOCTYPE" (let () (define source-string #< END ) (define source-document (read-xml (open-input-string source-string))) (define result-string (with-output-to-string (lambda () (write-xml source-document)))) (define expected-string #< END ) (test-equal? "DOCTYPE dropping" result-string expected-string))) (local [(define a-pi (make-p-i #f #f 'foo "bar")) (define a-p (make-prolog empty #f empty)) (define a-p/pi (make-prolog (list a-pi) #f (list))) (define a-d0 (make-document a-p (make-element #f #f 'html empty empty) empty)) (define a-d1 (make-document a-p (make-element #f #f 'html empty empty) (list a-pi))) (define a-d2 (make-document a-p/pi (make-element #f #f 'html empty empty) (list a-pi)))] (test-suite "PIs" (test-equal? "Display XML w/o pis" (with-output-to-string (lambda () (display-xml a-d0))) "\n") (test-equal? "Display XML w/ pi in doc-misc" (with-output-to-string (lambda () (display-xml a-d1))) "\n\n") (test-equal? "Display XML w/ pi in doc-misc and prolog" (with-output-to-string (lambda () (display-xml a-d2))) "\n\n\n")))) (test-suite "Datatypes" (test-suite "xexpr" (test-xexpr? "string") (test-xexpr? (list 'a (list (list 'href "#")) "content")) (test-xexpr? (list 'p "one" "two" "three")) (test-xexpr? 'nbsp) (test-xexpr? 10) (test-not-xexpr? 0) (test-xexpr? (make-cdata #f #f "unquoted ")) (test-xexpr? (make-comment "Comment!")) (test-xexpr? (make-pcdata #f #f "quoted ")) (test-not-xexpr? (list 'a (list (list 'href)) "content")) (test-not-xexpr? +) (test-not-xexpr? #f)) (test-not-false "xexpr/c" (contract? xexpr/c)) (test-not-false "document" (document? (make-document (make-prolog empty #f empty) (make-element #f #f 'br empty empty) empty))) (test-not-false "prolog" (prolog? (make-prolog empty #f empty))) (let ([c1 (make-comment "c1")] [c2 (make-comment "c2")]) (test-equal? "prolog" (prolog-misc2 (make-prolog empty #f (list c1 c2))) (list c1 c2))) (test-not-false "document-type" (document-type? (make-document-type 'name (make-external-dtd "string") #f))) (test-not-false "external-dtd" (external-dtd? (make-external-dtd "string"))) (test-not-false "external-dtd/public" (external-dtd/public? (make-external-dtd/public "string" "public"))) (test-not-false "external-dtd/system" (external-dtd/system? (make-external-dtd/system "string"))) (test-not-false "element" (element? (make-element #f #f 'br empty empty))) (local [(define content? (contract->predicate content/c))] (test-suite "content?" (test-not-false "content? pcdata" (content? (make-pcdata #f #f "pcdata"))) (test-not-false "content? element" (content? (make-element #f #f 'br empty empty))) (test-not-false "content? entity" (content? (make-entity #f #f 'nbsp))) (test-not-false "content? comment" (content? (make-comment "string"))) (test-not-false "content? cdata" (content? (make-cdata #f #f "cdata"))))) (test-not-false "attribute" (attribute? (make-attribute #f #f 'name "value"))) (test-not-false "entity symbol" (entity? (make-entity #f #f 'nbsp))) (test-not-false "entity number" (entity? (make-entity #f #f 10))) (test-not-false "pcdata" (pcdata? (make-pcdata #f #f "string"))) (test-not-false "cdata" (cdata? (make-cdata #f #f "string"))) (test-not-false "p-i" (p-i? (make-p-i #f #f 'target "instruction"))) (test-not-false "comment" (comment? (make-comment "text"))) (test-not-false "source" (source? (make-source 'start 'stop))) (test-not-false "source" (source? (make-source (make-location 1 2 3) 'stop))) (test-not-false "source" (source? (make-source 'start (make-location 1 2 3)))) (test-not-false "source" (source? (make-source (make-location 1 2 3) (make-location 4 5 6))))) (test-suite "Reading and Writing XML" (test-suite "read-xml" (test-read-xml/exn "<" "read-xml: lex-error: at position 1.1/2: unexpected eof") (test-read-xml/exn "" "read-xml: parse-error: unclosed `a' tag at [1.0/1 1.3/4]") (test-read-xml/exn "" "read-xml: parse-error: start tag `a' at [1.0/1 1.3/4] doesn't match end tag `b' at [1.3/4 1.7/8]") (test-read-xml/exn "" "read-xml: lex-error: at position 1.4/5: expected / or > to close tag `a'") (test-read-xml/exn "~n<" "read-xml: lex-error: at position 2.1/3: unexpected eof") (test-read-xml/exn "~n " "read-xml: parse-error: unclosed `a' tag at [2.0/2 2.3/5]") (test-read-xml/exn "~n " "read-xml: parse-error: start tag `a' at [2.0/2 2.3/5] doesn't match end tag `b' at [2.3/5 2.7/9]") (test-read-xml/exn "~n " "read-xml: lex-error: at position 2.4/6: expected / or > to close tag `a'") (test-read-xml/exn "" "read-xml: parse-error: expected root element - received #") (test-read-xml/exn "

" "read-xml: parse-error: extra stuff at end of document (element ") (test-read-xml "hi there!" '(make-document (make-prolog (list) #f (list)) (make-element (make-source (make-location 1 0 1) (make-location 1 33 34)) 'doc (list) (list (make-element (make-source (make-location 1 5 6) (make-location 1 20 21)) 'bold (list) (list (make-pcdata (make-source (make-location 1 11 12) (make-location 1 13 14)) "hi"))) (make-pcdata (make-source (make-location 1 20 21) (make-location 1 27 28)) " there!"))) (list))) (test-read-xml "inner" '(make-document (make-prolog (list) #f (list)) (make-element (make-source (make-location 1 0 1) (make-location 1 21 22)) 'a (list (make-attribute (make-source (make-location 1 3 4) (make-location 1 11 12)) href "#")) (list (make-pcdata (make-source (make-location 1 12 13) (make-location 1 17 18)) "inner"))) (list))) (test-read-xml " " '(make-document (make-prolog (list) #f (list)) (make-element (make-source (make-location 1 0 1) (make-location 1 19 20)) 'root (list) (list (make-entity (make-source (make-location 1 6 7) (make-location 1 12 13)) 'nbsp))) (list))) (test-read-xml "(" '(make-document (make-prolog (list) #f (list)) (make-element (make-source (make-location 1 0 1) (make-location 1 18 19)) 'root (list) (list (make-entity (make-source (make-location 1 6 7) (make-location 1 11 12)) '40))) (list))) (test-read-xml/exn "�" "read-xml: lex-error: at position 1.10/11: not a well-formed numeric entity (does not match the production for Char, see XML 4.1)") (test-read-xml "
" '(make-document (make-prolog (list) #f (list)) (make-element (make-source (make-location 1 16 17) (make-location 1 22 23)) 'br (list) (list)) (list))) (test-read-xml "
" '(make-document (make-prolog (list (make-p-i (make-source (make-location 1 0 1) (make-location 1 56 57)) xml "version=\"1.0\"? encoding=\"UTF-8\" standalone=\"yes\"")) #f (list)) (make-element (make-source (make-location 1 56 57) (make-location 1 62 63)) 'br (list) (list)) (list))) (test-read-xml #:document-different? #t "
" '(make-document (make-prolog (list) #f (list)) (make-element (make-source (make-location 1 0 1) (make-location 1 6 7)) 'br (list) (list)) (list (make-p-i (make-source (make-location 1 6 7) (make-location 1 62 63)) xml "version=\"1.0\"? encoding=\"UTF-8\" standalone=\"yes\"")))) ; XXX need more read-xml tests ) (test-suite "read-xml/element" (test-read-xml/element/exn "<" "read-xml: lex-error: at position 1.1/2: unexpected eof") (test-read-xml/element/exn "" "read-xml: parse-error: unclosed `a' tag at [1.0/1 1.3/4]") (test-read-xml/element/exn "" "read-xml: parse-error: start tag `a' at [1.0/1 1.3/4] doesn't match end tag `b' at [1.3/4 1.7/8]") (test-read-xml/element/exn "" "read-xml: lex-error: at position 1.4/5: expected / or > to close tag `a'") (test-read-xml/element/exn "~n<" "read-xml: lex-error: at position 2.1/3: unexpected eof") (test-read-xml/element/exn "~n " "read-xml: parse-error: unclosed `a' tag at [2.0/2 2.3/5]") (test-read-xml/element/exn "~n " "read-xml: parse-error: start tag `a' at [2.0/2 2.3/5] doesn't match end tag `b' at [2.3/5 2.7/9]") (test-read-xml/element/exn "~n " "read-xml: lex-error: at position 2.4/6: expected / or > to close tag `a'") (test-read-xml/element/exn "" "read-xml: parse-error: expected root element - received #") (test-read-xml/element "

" '(make-element (make-source (make-location 1 0 1) (make-location 1 6 7)) 'br (list) (list))) (test-read-xml/element "hi there!" '(make-element (make-source (make-location 1 0 1) (make-location 1 33 34)) 'doc (list) (list (make-element (make-source (make-location 1 5 6) (make-location 1 20 21)) 'bold (list) (list (make-pcdata (make-source (make-location 1 11 12) (make-location 1 13 14)) "hi"))) (make-pcdata (make-source (make-location 1 20 21) (make-location 1 27 28)) " there!")))) (test-read-xml/element "inner" '(make-element (make-source (make-location 1 0 1) (make-location 1 21 22)) 'a (list (make-attribute (make-source (make-location 1 3 4) (make-location 1 11 12)) href "#")) (list (make-pcdata (make-source (make-location 1 12 13) (make-location 1 17 18)) "inner")))) (test-read-xml/element " " '(make-element (make-source (make-location 1 0 1) (make-location 1 19 20)) 'root (list) (list (make-entity (make-source (make-location 1 6 7) (make-location 1 12 13)) 'nbsp)))) (test-read-xml/element "(" '(make-element (make-source (make-location 1 0 1) (make-location 1 18 19)) 'root (list) (list (make-entity (make-source (make-location 1 6 7) (make-location 1 11 12)) '40)))) (test-read-xml/element/exn "
" "read-xml: parse-error: expected root element - received (comment ") (test-read-xml/element "<![CDATA[hello world[mp3]]]>" '(make-element (make-source (make-location 1 0 1) (make-location 1 43 44)) 'title (list) (list (make-cdata (make-source (make-location 1 7 8) (make-location 1 35 36)) "")))) (test-read-xml/element "<![CDATA[]]]>" '(make-element (make-source (make-location 1 0 1) (make-location 1 28 29)) 'title (list) (list (make-cdata (make-source (make-location 1 7 8) (make-location 1 20 21)) "")))) ; XXX need more read-xml/element tests ) (test-suite "syntax:read-xml" (test-syntax:read-xml/exn "<" "read-xml: lex-error: at position 1.1/2: unexpected eof") (test-syntax:read-xml/exn "" "read-xml: parse-error: unclosed `a' tag at [1.0/1 1.3/4]") (test-syntax:read-xml/exn "" "read-xml: parse-error: start tag `a' at [1.0/1 1.3/4] doesn't match end tag `b' at [1.3/4 1.7/8]") (test-syntax:read-xml/exn "" "read-xml: lex-error: at position 1.4/5: expected / or > to close tag `a'") (test-syntax:read-xml/exn "~n<" "read-xml: lex-error: at position 2.1/3: unexpected eof") (test-syntax:read-xml/exn "~n " "read-xml: parse-error: unclosed `a' tag at [2.0/2 2.3/5]") (test-syntax:read-xml/exn "~n " "read-xml: parse-error: start tag `a' at [2.0/2 2.3/5] doesn't match end tag `b' at [2.3/5 2.7/9]") (test-syntax:read-xml/exn "~n " "read-xml: lex-error: at position 2.4/6: expected / or > to close tag `a'") (test-syntax:read-xml/exn "" "read-xml: parse-error: expected root element - received #") (test-syntax:read-xml/exn "

" "read-xml: parse-error: extra stuff at end of document (element ") (test-syntax:read-xml "hi there!" '(doc () (bold () "hi") " there!")) (test-syntax:read-xml "inner" '(a ([href "#"]) "inner")) (test-syntax:read-xml " " '(root () nbsp)) (test-syntax:read-xml "(" '(root () 40)) (test-syntax:read-xml "
" '(br ())) ; XXX need more syntax:read-xml tests ) (test-suite "syntax:read-xml/element" (test-syntax:read-xml/element/exn "<" "read-xml: lex-error: at position 1.1/2: unexpected eof") (test-syntax:read-xml/element/exn "" "read-xml: parse-error: unclosed `a' tag at [1.0/1 1.3/4]") (test-syntax:read-xml/element/exn "" "read-xml: parse-error: start tag `a' at [1.0/1 1.3/4] doesn't match end tag `b' at [1.3/4 1.7/8]") (test-syntax:read-xml/element/exn "" "read-xml: lex-error: at position 1.4/5: expected / or > to close tag `a'") (test-syntax:read-xml/element/exn "~n<" "read-xml: lex-error: at position 2.1/3: unexpected eof") (test-syntax:read-xml/element/exn "~n " "read-xml: parse-error: unclosed `a' tag at [2.0/2 2.3/5]") (test-syntax:read-xml/element/exn "~n " "read-xml: parse-error: start tag `a' at [2.0/2 2.3/5] doesn't match end tag `b' at [2.3/5 2.7/9]") (test-syntax:read-xml/element/exn "~n " "read-xml: lex-error: at position 2.4/6: expected / or > to close tag `a'") (test-syntax:read-xml/element/exn "" "read-xml: parse-error: expected root element - received #") (test-syntax:read-xml/element "

" '(br ())) (test-syntax:read-xml/element "hi there!" '(doc () (bold () "hi") " there!")) (test-syntax:read-xml/element "inner" '(a ([href "#"]) "inner")) (test-syntax:read-xml/element " " '(root () nbsp)) (test-syntax:read-xml/element "(" '(root () 40)) (test-syntax:read-xml/element/exn "
" "read-xml: parse-error: expected root element - received (comment ") ; XXX need more syntax:read-xml/element tests ) (test-suite "write-xml" (test-write-xml "hi there!") (test-write-xml "inner") (test-write-xml " ") (test-write-xml "(") (test-write-xml "
") ; XXX need more write-xml tests ) (test-suite "write-xml/content" (test-write-xml/content "hi there!") (test-write-xml/content "inner") (test-write-xml/content " ") (test-write-xml/content "(") (test-write-xml/content "
") ; XXX need more write-xml/content tests ) (test-suite "display-xml" (test-display-xml "hi there!" "\n\n \n hi\n \n there!\n") (test-display-xml "inner" "\n\n inner\n") (test-display-xml " " "\n \n") (test-display-xml "(" "\n(\n") (test-display-xml "
" "\n
") ; XXX need more display-xml tests ) (test-suite "display-xml/content" (test-display-xml/content "hi there!" "\n\n \n hi\n \n there!\n") (test-display-xml/content "inner" "\n\n inner\n") (test-display-xml/content " " "\n \n") (test-display-xml/content "(" "\n(\n") (test-display-xml/content "
" "\n
") ; XXX need more display-xml/content tests ) ) (local [(define (test-xml->xexpr str xe) (test-equal? str (string->xexpr str) xe)) (define (test-xexpr->string xe str) (test-equal? (format "~S" xe) (xexpr->string xe) str) (test-equal? (format "~S" xe) (with-output-to-string (λ () (write-xexpr xe))) str) (test-string->xexpr str xe)) (define (test-string->xexpr str xe) (test-equal? str (string->xexpr str) xe))] (test-suite "XML and X-expression Conversions" (test-suite "xml->xexpr" (test-xml->xexpr "hi there!" '(doc () (bold () "hi") " there!")) (test-xml->xexpr "inner" '(a ([href "#"]) "inner")) (test-xml->xexpr " " '(root () nbsp)) (test-xml->xexpr "(" '(root () 40)) ; XXX more xml->xexpr tests ) (test-suite "xexpr->string" (test-xexpr->string '(doc () (bold () "hi") " there!") "hi there!") (test-xexpr->string '(a ([href "#"]) "inner") "inner") (test-xexpr->string '(root () nbsp) " ") (test-xexpr->string '(root () 40) "(") ; XXX more xexpr->string tests ) (test-suite "string->xexpr" (test-string->xexpr "\n\n\n" '(html ())) (parameterize ([xexpr-drop-empty-attributes #t]) (test-string->xexpr "\n\n\n" '(html)))) (local [(define (test-eliminate-whitespace tags choose str res) (test-equal? (format "~S" (list tags choose str)) (with-output-to-string (lambda () (write-xml/content ((eliminate-whitespace tags choose) (read-xml/element (open-input-string str)))))) res)) (define (test-eliminate-whitespace/exn tags choose str msg) (test-exn (format "~S" (list tags choose str)) (lambda (x) (and (exn? x) (regexp-match (regexp-quote msg) (exn-message x)))) (lambda () (with-output-to-string (lambda () (write-xml/content ((eliminate-whitespace tags choose) (read-xml/element (open-input-string str))))))))) (define (truer x) #t)] (test-suite "eliminate-whitespace" (test-equal? "Defaults" (with-output-to-string (lambda () (write-xml/content ((eliminate-whitespace) (read-xml/element (open-input-string "\n

Hey

")))))) "\n

Hey

") (test-eliminate-whitespace empty identity "\n

Hey

" "\n

Hey

") (test-eliminate-whitespace/exn empty not "\n

Hey

" "not allowed to contain text") (test-eliminate-whitespace/exn empty truer "\n

Hey

" "not allowed to contain text") (test-eliminate-whitespace '(html) identity "\n

Hey

" "

Hey

") (test-eliminate-whitespace/exn '(html) not "\n

Hey

" "not allowed to contain text") (test-eliminate-whitespace/exn '(html) truer "\n

Hey

" "not allowed to contain text") (test-eliminate-whitespace '(html) identity "\n

" "

") (test-eliminate-whitespace '(html) not "\n

" "\n

") (test-eliminate-whitespace '(html) truer "\n

" "

"))) (local [(define (test-validate-xexpr xe) (test-not-false (format "~S" xe) (validate-xexpr xe))) (define (test-validate-xexpr/exn xe v) (test-exn (format "~S" xe) (lambda (x) (and (exn:invalid-xexpr? x) (equal? (exn:invalid-xexpr-code x) v))) (lambda () (validate-xexpr xe))))] (test-suite "validate-xexpr" (test-validate-xexpr 64) (test-validate-xexpr 'nbsp) (test-validate-xexpr "string") (test-validate-xexpr (make-pcdata #f #f "pcdata")) (test-validate-xexpr (make-cdata #f #f "cdata")) (test-validate-xexpr (make-comment "comment")) (test-validate-xexpr (make-p-i #f #f 's1 "s2")) (test-validate-xexpr '(br)) (test-validate-xexpr '(br ())) (test-validate-xexpr '(a ([href "#"]) "string")) (test-validate-xexpr/exn #f #f) (test-validate-xexpr/exn 4 4) (test-validate-xexpr/exn + +) (test-validate-xexpr/exn '(a ([href foo]) bar) 'foo) (test-validate-xexpr/exn '("foo" bar) '("foo" bar)))) ; XXX correct-xexpr? (test-suite "permissive-xexprs" (test-exn "Non-permissive" (lambda (exn) (and (exn? exn) (regexp-match #rx"not in permissive mode" (exn-message exn)))) (lambda () (xml->xexpr #f))) (test-false "Permissive" (parameterize ([permissive-xexprs #t]) (xml->xexpr #f)))))) (local [(define ((mk-test-param param) v istr ostr) (test-equal? (format "~S" (list v istr)) (parameterize ([param v]) (with-output-to-string (lambda () (write-xml (read-xml (open-input-string istr)))))) ostr)) (define test-empty-tag-shorthand (mk-test-param empty-tag-shorthand)) (define test-collapse-whitespace (mk-test-param collapse-whitespace)) (define test-read-comments (mk-test-param read-comments))] (test-suite "Parameters" (test-suite "empty-tag-shorthand" (test-empty-tag-shorthand 'always "" "") (test-empty-tag-shorthand 'always "Hey" "Hey") (test-empty-tag-shorthand 'never "" "") (test-empty-tag-shorthand 'never "Hey" "Hey") (test-empty-tag-shorthand empty "" "") (test-empty-tag-shorthand empty "Hey" "Hey") (test-empty-tag-shorthand '(html) "" "") (test-empty-tag-shorthand '(html) "Hey" "Hey") (test-empty-tag-shorthand '(p) "" "") (test-empty-tag-shorthand '(p) "Hey" "Hey")) (test-equal? "html-empty-tags" html-empty-tags '(param meta link isindex input img hr frame col br basefont base area)) (test-suite "collapse-whitespace" (test-collapse-whitespace #t "\n" " ") (test-collapse-whitespace #t "\t" " ") (test-collapse-whitespace #t " " " ") (test-collapse-whitespace #t "" "") (test-collapse-whitespace #t "" "") (test-collapse-whitespace #t "" "") (test-collapse-whitespace #f "\n" "\n")) (test-suite "read-comments" (test-read-comments #f "" "") (test-read-comments #t "" "")) (local [(define (test-xexpr-drop-empty-attributes v istr xe) (test-equal? (format "~S" (list v istr)) (parameterize ([xexpr-drop-empty-attributes v]) (xml->xexpr (document-element (read-xml (open-input-string istr))))) xe))] (test-suite "xexpr-drop-empty-attributes" (test-xexpr-drop-empty-attributes #f "" '(html ())) (test-xexpr-drop-empty-attributes #t "" '(html)) (test-xexpr-drop-empty-attributes #f "Hey" '(html () "Hey")) (test-xexpr-drop-empty-attributes #t "Hey" '(html "Hey")) (test-xexpr-drop-empty-attributes #f "Hey" '(a ([href "#"]) "Hey")) (test-xexpr-drop-empty-attributes #t "Hey" '(a ([href "#"]) "Hey")))))) (local [(define example `(dict (assoc-pair "first-key" "just a string with some whitespace in it") (assoc-pair "second-key" (false)) (assoc-pair "third-key" (dict )) (assoc-pair "fourth-key" (dict (assoc-pair "inner-key" (real 3.432)))) (assoc-pair "fifth-key" (array (integer 14) "another string" (true))) (assoc-pair "sixth-key" (array)))) (define example-str #< first-keyjust a string with some whitespace in itsecond-keythird-keyfourth-keyinner-key3.432fifth-key14another stringsixth-key END )] (test-suite "PList Library" (test-not-false "plist-dict?" (plist-dict? example)) (test-false "plist-dict?" (plist-dict? `(p "Hey"))) (test-false "plist-dict?" (plist-dict? `(dict (p "Hey")))) (test-false "plist-dict?" (plist-dict? `(dict (assoc-pair "key" 2 3)))) (test-false "plist-dict?" (plist-dict? `(dict (assoc-pair 1 2)))) (test-false "plist-dict?" (plist-dict? `(dict (assoc-pair "key" #f)))) (test-equal? "read-plist" (read-plist (open-input-string example-str)) example) (test-equal? "write-plist" (with-output-to-string (lambda () (write-plist example (current-output-port)))) example-str) (local [(define (test-plist-round-trip plist) (define-values (in out) (make-pipe)) (write-plist plist out) (close-output-port out) (test-equal? (format "~S" plist) (read-plist in) plist))] (test-plist-round-trip example)))))) (run-tests xml-tests)