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 ;
10 TAGS: calculate ( tag -- n )
12 : calc-2children ( tag -- n n )
13 children-tags first2 [ calculate ] dip calculate ;
16 children>string string>number ;
26 children-tags first calculate neg ;
28 : calc-arith ( string -- n )
29 string>xml first-child-tag calculate ;
32 "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
36 XML-NS: foo http://blah.com
38 [ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
42 [ "a" "c" { "a" "c" f } ] [
43 "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
46 [ fourth "val" attr var>> ]
47 [ extract-variables ] tri
50 [ """<?xml version="1.0" encoding="UTF-8"?>
57 [let* | a [ "one" ] c [ "two" ] x [ "y" ]
58 d [ [XML <-x-> <foo/> XML] ] |
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 ] unit-test
95 [ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
96 [ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
97 [ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] 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