Fixing failing XML unit tests
							parent
							
								
									99172b6f79
								
							
						
					
					
						commit
						cea24feaa9
					
				|  | @ -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 | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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 -- ) | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue