! 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 inverse xml.writer splitting classes
xml.private ;
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 "one" :> a "two" :> c "y" :> x [XML <-x-> XML] :> d
<-a-> /> <-d->
XML> pprint-xml>string
]
] unit-test
{ "
-
one
-
two
-
three
" } [
"one two three" split-words
[ [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-of ] unit-test
{ xml } [ [ XML> ] first class-of ] unit-test
{ xml-chunk } [ [ [XML /> XML] ] third class-of ] unit-test
{ xml } [ [ /> XML> ] third class-of ] 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
! Make sure nested XML documents interpolate correctly
{
"it's blue!"
} [
"it's blue!" <-> XML>
<-> XML> xml>string
] unit-test
{
"asdfasdf2"
} [
default-prolog
"asdf"
"asdf" f f
"asdf2"
<-> XML> xml>string
] unit-test