Fixing failing XML unit tests

db4
Daniel Ehrenberg 2008-01-31 00:47:11 -06:00
parent 99172b6f79
commit cea24feaa9
3 changed files with 9 additions and 8 deletions

View File

@ -1,4 +1,3 @@
IN: templating
USING: kernel xml sequences assocs tools.test io arrays namespaces
xml.data xml.utilities xml.writer generic sequences.deep ;
@ -9,10 +8,10 @@ SYMBOL: ref-table
GENERIC: (r-ref) ( xml -- )
M: tag (r-ref)
sub-tag over at [
sub-tag over at* [
ref-table get at
swap set-tag-children
] [ drop ] if* ;
] [ 2drop ] if ;
M: object (r-ref) drop ;
: template ( xml -- )
@ -40,4 +39,4 @@ M: object (r-ref) drop ;
sample-doc string>xml dup template xml>string
] with-scope ;
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test

View File

@ -26,7 +26,7 @@ SYMBOL: xml-file
] unit-test
[ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test
[ "that" ] [ xml-file get "this" swap at ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<a b=\"c\"/>" ]
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><a b=\"c\"/>" ]
[ "<a b='c'/>" string>xml xml>string ] unit-test
[ "abcd" ] [
"<main>a<sub>bc</sub>d<nothing/></main>" string>xml
@ -44,7 +44,7 @@ SYMBOL: xml-file
at swap "z" >r tuck r> swap set-at
T{ name f "blah" "z" f } swap at ] unit-test
[ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<foo>bar baz</foo>" ]
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><foo>bar baz</foo>" ]
[ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<foo>\n bar\n</foo>" ]
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test

View File

@ -14,7 +14,9 @@ SYMBOL: indenter
sensitive-tags get swap [ names-match? ] curry contains? ;
: indent-string ( -- string )
indentation get indenter get <repetition> concat ;
xml-pprint? get
[ indentation get indenter get <repetition> concat ]
[ "" ] if ;
: ?indent ( -- )
xml-pprint? get [ nl indent-string write ] when ;
@ -53,7 +55,7 @@ SYMBOL: indenter
GENERIC: write-item ( object -- )
M: string write-item
escape-string xml-pprint? over empty? not and
escape-string dup empty? not xml-pprint? get and
[ nl 80 indent-string indented-break ] when write ;
: write-tag ( tag -- )