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

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

@ -481,7 +481,10 @@ END
[(define (test-xml->xexpr str xe) [(define (test-xml->xexpr str xe)
(test-equal? str (string->xexpr str) xe)) (test-equal? str (string->xexpr str) xe))
(define (test-xexpr->string xe str) (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 (test-suite
"XML and X-expression Conversions" "XML and X-expression Conversions"
@ -519,6 +522,14 @@ END
; XXX more xexpr->string tests ; 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 (local
[(define (test-eliminate-whitespace tags choose str res) [(define (test-eliminate-whitespace tags choose str res)
(test-equal? (format "~S" (list tags choose str)) (test-equal? (format "~S" (list tags choose str))

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

@ -233,7 +233,7 @@
(get-output-string port))) (get-output-string port)))
(define (string->xexpr str) (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) ;; bcompose : (a a -> c) (b -> a) -> (b b -> c)
(define (bcompose f g) (define (bcompose f g)