basis/xml/syntax/syntax-tests.factor

   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 inverse xml.writer splitting classes
   6 xml.private ;
   7 IN: xml.syntax.tests
   8
   9 ! TAGS test
  10
  11 TAGS: calculate ( tag -- n )
  12
  13 : calc-2children ( tag -- n n )
  14     children-tags first2 [ calculate ] dip calculate ;
  15
  16 TAG: number calculate
  17     children>string string>number ;
  18 TAG: add calculate
  19     calc-2children + ;
  20 TAG: minus calculate
  21     calc-2children - ;
  22 TAG: times calculate
  23     calc-2children * ;
  24 TAG: divide calculate
  25     calc-2children / ;
  26 TAG: neg calculate
  27     children-tags first calculate neg ;
  28
  29 : calc-arith ( string -- n )
  30     string>xml first-child-tag calculate ;
  31
  32 { 32 } [
  33     "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
  34     calc-arith
  35 ] unit-test
  36
  37 XML-NS: foo http://blah.com
  38
  39 { T{ name { main "bling" } { url "http://blah.com" } } } [ "bling" foo ] unit-test
  40
  41 ! XML literals
  42
  43 { "a" "c" { "a" "c" f } } [
  44     "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
  45     string>doc
  46     [ second var>> ]
  47     [ fourth "val" attr var>> ]
  48     [ extract-variables ] tri
  49 ] unit-test
  50
  51 { "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
  52 <x>
  53   one
  54   <b val=\"two\"/>
  55   y
  56   <foo/>
  57 </x>" } [
  58     [let "one" :> a "two" :> c "y" :> x [XML <-x-> <foo/> XML] :> d
  59         <XML
  60             <x> <-a-> <b val=<-c->/> <-d-> </x>
  61         XML> pprint-xml>string
  62     ]
  63 ] unit-test
  64
  65 { "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
  66 <doc>
  67   <item>
  68     one
  69   </item>
  70   <item>
  71     two
  72   </item>
  73   <item>
  74     three
  75   </item>
  76 </doc>" } [
  77     "one two three" split-words
  78     [ [XML <item><-></item> XML] ] map
  79     <XML <doc><-></doc> XML> pprint-xml>string
  80 ] unit-test
  81
  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
  87
  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
  90
  91 [ [XML <-> XML] ] must-infer
  92 [ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
  93
  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
 100
 101 { "" } [ [XML XML] concat ] unit-test
 102
 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
 106
 107 : dispatch ( xml -- string )
 108     {
 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 ] }
 113     } switch ;
 114
 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
 122
 123 : dispatch-doc ( xml -- string )
 124     {
 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 ] }
 129     } switch ;
 130
 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
 134
 135 ! Make sure nested XML documents interpolate correctly
 136 {
 137     "<?xml version=\"1.0\" encoding=\"UTF-8\"?><color><blue>it's blue!</blue></color>"
 138 } [
 139     "it's blue!" <XML <blue><-></blue> XML>
 140     <XML <color><-></color> XML> xml>string
 141 ] unit-test
 142
 143 {
 144     "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a>asdf<asdf/>asdf2</a>"
 145 } [
 146     default-prolog
 147     "asdf"
 148     "asdf" f f <tag>
 149     "asdf2" <xml>
 150     <XML <a><-></a> XML> xml>string
 151 ] unit-test