! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: xml io kernel math sequences strings xml.traversal
tools.test math.parser xml.syntax xml.data xml.syntax.private
accessors multiline locals inverse xml.writer splitting classes ;
IN: xml.syntax.tests
! TAGS test
TAGS: calculate ( tag -- n )
: calc-2children ( tag -- n n )
children-tags first2 [ calculate ] dip calculate ;
TAG: number calculate
children>string string>number ;
TAG: add calculate
calc-2children + ;
TAG: minus calculate
calc-2children - ;
TAG: times calculate
calc-2children * ;
TAG: divide calculate
calc-2children / ;
TAG: neg calculate
children-tags first calculate neg ;
: calc-arith ( string -- n )
string>xml first-child-tag calculate ;
[ 32 ] [
""
calc-arith
] unit-test
XML-NS: foo http://blah.com
[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
! XML literals
[ "a" "c" { "a" "c" f } ] [
"<-a->/><->"
string>doc
[ second var>> ]
[ fourth "val" attr var>> ]
[ extract-variables ] tri
] unit-test
[ {"
one
y
"} ] [
[let* | a [ "one" ] c [ "two" ] x [ "y" ]
d [ [XML <-x-> XML] ] |
<-a-> /> <-d->
XML> pprint-xml>string
]
] unit-test
[ {"
-
one
-
two
-
three
"} ] [
"one two three" " " split
[ [XML - <->
XML] ] map
<-> XML> pprint-xml>string
] unit-test
[ {"
"} ]
[ 3 f "http://factorcode.org/" "hello" \ drop
false=<-> url=<-> string=<-> word=<->/> XML>
pprint-xml>string ] unit-test
[ "3" ] [ 3 [XML <-> XML] xml>string ] unit-test
[ "" ] [ f [XML <-> XML] xml>string ] unit-test
[ [XML <-> XML] ] must-infer
[ [XML <-> /> XML] ] must-infer
[ xml-chunk ] [ [ [XML XML] ] first class ] unit-test
[ xml ] [ [ XML> ] first class ] unit-test
[ xml-chunk ] [ [ [XML /> XML] ] third class ] unit-test
[ xml ] [ [ /> XML> ] third class ] unit-test
[ 1 ] [ [ [XML XML] ] length ] unit-test
[ 1 ] [ [ XML> ] length ] unit-test
[ "" ] [ [XML XML] concat ] unit-test
[ "foo" ] [ [XML foo XML] [ [XML <-> XML] ] undo ] unit-test
[ "foo" ] [ [XML XML] [ [XML /> XML] ] undo ] unit-test
[ "foo" "baz" ] [ [XML baz XML] [ [XML ><-> XML] ] undo ] unit-test
: dispatch ( xml -- string )
{
{ [ [XML <-> XML] ] [ "a" prepend ] }
{ [ [XML <-> XML] ] [ "b" prepend ] }
{ [ [XML XML] ] [ "byes" ] }
{ [ [XML /> XML] ] [ "bno" prepend ] }
} switch ;
[ "apple" ] [ [XML pple XML] dispatch ] unit-test
[ "banana" ] [ [XML anana XML] dispatch ] unit-test
[ "byes" ] [ [XML XML] dispatch ] unit-test
[ "bnowhere" ] [ [XML XML] dispatch ] unit-test
[ "baboon" ] [ [XML aboon XML] dispatch ] unit-test
[ "apple" ] [ pple XML> dispatch ] unit-test
[ "apple" ] [ pple XML> body>> dispatch ] unit-test
: dispatch-doc ( xml -- string )
{
{ [ <-> XML> ] [ "a" prepend ] }
{ [ <-> XML> ] [ "b" prepend ] }
{ [ XML> ] [ "byes" ] }
{ [ /> XML> ] [ "bno" prepend ] }
} switch ;
[ "apple" ] [ pple XML> dispatch-doc ] unit-test
[ "apple" ] [ [XML pple XML] dispatch-doc ] unit-test
[ "apple" ] [ pple XML> body>> dispatch-doc ] unit-test