suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Making string->xexpr more permissive

Browse Source
This commit is contained in:
Jay McCarthy 2010-05-27 10:48:05 -06:00
parent 103d53f6ad
commit 08a48a67a0
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/tests/xml/test.rkt
View File

@ -481,7 +481,10 @@ END
[(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) (xexpr->string 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"
@ -519,12 +522,20 @@ END
; XXX more xexpr->string tests
)
(test-suite
"string->xexpr"
(test-string->xexpr "<?foo bar?>\n\n<html /><?foo bar?>\n"
'(html ()))
(parameterize ([xexpr-drop-empty-attributes #t])
(test-string->xexpr "<?foo bar?>\n\n<html /><?foo bar?>\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))))))
(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))
@ -533,8 +544,8 @@ END
(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)))))))))
(lambda ()
(write-xml/content ((eliminate-whitespace tags choose) (read-xml/element (open-input-string str)))))))))
(define (truer x) #t)]
(test-suite
"eliminate-whitespace"
@ -601,8 +612,8 @@ END
(test-equal? (format "~S" (list v istr))
(parameterize ([param v])
(with-output-to-string
(lambda ()
(write-xml (read-xml (open-input-string istr))))))
(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))
@ -715,8 +726,8 @@ END
(test-equal? "write-plist"
(with-output-to-string
(lambda ()
(write-plist example (current-output-port))))
(lambda ()
(write-plist example (current-output-port))))
example-str)
(local [(define (test-plist-round-trip plist)

2
collects/xml/private/xexpr.rkt
View File

@ -233,7 +233,7 @@
(get-output-string port)))
(define (string->xexpr str)
(xml->xexpr (read-xml/element (open-input-string str))))
(xml->xexpr (document-element (read-xml (open-input-string str)))))
;; bcompose : (a a -> c) (b -> a) -> (b b -> c)
(define (bcompose f g)