steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
extra/xml/test/templating.factor
View File

@ -1,4 +1,3 @@
IN: templating
USING: kernel xml sequences assocs tools.test io arrays namespaces USING: kernel xml sequences assocs tools.test io arrays namespaces
xml.data xml.utilities xml.writer generic sequences.deep ; xml.data xml.utilities xml.writer generic sequences.deep ;
@ -9,10 +8,10 @@ SYMBOL: ref-table
GENERIC: (r-ref) ( xml -- ) GENERIC: (r-ref) ( xml -- )
M: tag (r-ref) M: tag (r-ref)
sub-tag over at [ sub-tag over at* [
ref-table get at ref-table get at
swap set-tag-children swap set-tag-children
] [ drop ] if* ; ] [ 2drop ] if ;
M: object (r-ref) drop ; M: object (r-ref) drop ;
: template ( xml -- ) : template ( xml -- )
@ -40,4 +39,4 @@ M: object (r-ref) drop ;
sample-doc string>xml dup template xml>string sample-doc string>xml dup template xml>string
] with-scope ; ] 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

4
extra/xml/test/test.factor
View File

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

6
extra/xml/writer/writer.factor
View File

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