1 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: xml io kernel math sequences strings xml.traversal
4 tools.test math.parser xml.syntax xml.data xml.syntax.private
5 accessors multiline locals inverse xml.writer splitting classes
11 TAGS: calculate ( tag -- n )
13 : calc-2children ( tag -- n n )
14 children-tags first2 [ calculate ] dip calculate ;
17 children>string string>number ;
27 children-tags first calculate neg ;
29 : calc-arith ( string -- n )
30 string>xml first-child-tag calculate ;
33 "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
37 XML-NS: foo http://blah.com
39 { T{ name { main "bling" } { url "http://blah.com" } } } [ "bling" foo ] unit-test
43 { "a" "c" { "a" "c" f } } [
44 "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
47 [ fourth "val" attr var>> ]
48 [ extract-variables ] tri
51 { "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
58 [let "one" :> a "two" :> c "y" :> x [XML <-x-> <foo/> XML] :> d
60 <x> <-a-> <b val=<-c->/> <-d-> </x>
61 XML> pprint-xml>string
65 { "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
77 "one two three" " " split
78 [ [XML <item><-></item> XML] ] map
79 <XML <doc><-></doc> XML> pprint-xml>string
82 { "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
83 <x number=\"3\" url=\"http://factorcode.org/\" string=\"hello\" word=\"drop\"/>" }
84 [ 3 f "http://factorcode.org/" "hello" \ drop
85 <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
86 pprint-xml>string ] unit-test
88 { "<x>3</x>" } [ 3 [XML <x><-></x> XML] xml>string ] unit-test
89 { "<x></x>" } [ f [XML <x><-></x> XML] xml>string ] unit-test
91 [ [XML <-> XML] ] must-infer
92 [ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
94 { xml-chunk } [ [ [XML <foo/> XML] ] first class-of ] unit-test
95 { xml } [ [ <XML <foo/> XML> ] first class-of ] unit-test
96 { xml-chunk } [ [ [XML <foo val=<->/> XML] ] third class-of ] unit-test
97 { xml } [ [ <XML <foo val=<->/> XML> ] third class-of ] unit-test
98 { 1 } [ [ [XML <foo/> XML] ] length ] unit-test
99 { 1 } [ [ <XML <foo/> XML> ] length ] unit-test
101 { "" } [ [XML XML] concat ] unit-test
103 { "foo" } [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
104 { "foo" } [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
105 { "foo" "baz" } [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test
107 : dispatch ( xml -- string )
109 { [ [XML <a><-></a> XML] ] [ "a" prepend ] }
110 { [ [XML <b><-></b> XML] ] [ "b" prepend ] }
111 { [ [XML <b val='yes'/> XML] ] [ "byes" ] }
112 { [ [XML <b val=<->/> XML] ] [ "bno" prepend ] }
115 { "apple" } [ [XML <a>pple</a> XML] dispatch ] unit-test
116 { "banana" } [ [XML <b>anana</b> XML] dispatch ] unit-test
117 { "byes" } [ [XML <b val="yes"/> XML] dispatch ] unit-test
118 { "bnowhere" } [ [XML <b val="where"/> XML] dispatch ] unit-test
119 { "baboon" } [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
120 { "apple" } [ <XML <a>pple</a> XML> dispatch ] unit-test
121 { "apple" } [ <XML <a>pple</a> XML> body>> dispatch ] unit-test
123 : dispatch-doc ( xml -- string )
125 { [ <XML <a><-></a> XML> ] [ "a" prepend ] }
126 { [ <XML <b><-></b> XML> ] [ "b" prepend ] }
127 { [ <XML <b val='yes'/> XML> ] [ "byes" ] }
128 { [ <XML <b val=<->/> XML> ] [ "bno" prepend ] }
131 { "apple" } [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
132 { "apple" } [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
133 { "apple" } [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test
135 ! Make sure nested XML documents interpolate correctly
137 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><color><blue>it's blue!</blue></color>"
139 "it's blue!" <XML <blue><-></blue> XML>
140 <XML <color><-></color> XML> xml>string
144 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a>asdf<asdf/>asdf2</a>"
150 <XML <a><-></a> XML> xml>string