factor: trim using lists

[factor.git] / basis / xml / syntax / syntax-tests.factor

diff --git a/basis/xml/syntax/syntax-tests.factor b/basis/xml/syntax/syntax-tests.factor
index 06ba2028a67a1d4e10ae7b12cffa2bcde735ef56..e002c3fb99c29b7295589cbd4a690f8a7c1dd8ef 100644 (file)
--- a/basis/xml/syntax/syntax-tests.factor
+++ b/basis/xml/syntax/syntax-tests.factor
@@ -2,7 +2,8 @@
 ! 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 ;
+accessors multiline inverse xml.writer splitting classes
+xml.private ;
 IN: xml.syntax.tests
 
 ! TAGS test
@@ -28,18 +29,18 @@ TAG: neg calculate
 : calc-arith ( string -- n )
     string>xml first-child-tag calculate ;
 
-[ 32 ] [
+{ 32 } [
     "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
     calc-arith
 ] unit-test
 
 XML-NS: foo http://blah.com
 
-[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
+{ T{ name { main "bling" } { url "http://blah.com" } } } [ "bling" foo ] unit-test
 
 ! XML literals
 
-[ "a" "c" { "a" "c" f } ] [
+{ "a" "c" { "a" "c" f } } [
     "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
     string>doc
     [ second var>> ]
@@ -47,22 +48,21 @@ XML-NS: foo http://blah.com
     [ extract-variables ] tri
 ] unit-test
 
-[ {" <?xml version="1.0" encoding="UTF-8"?>
+{ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
 <x>
   one
-  <b val="two"/>
+  <b val=\"two\"/>
   y
   <foo/>
-</x>"} ] [
-    [let* | a [ "one" ] c [ "two" ] x [ "y" ]
-           d [ [XML <-x-> <foo/> XML] ] |
+</x>" } [
+    [let "one" :> a "two" :> c "y" :> x [XML <-x-> <foo/> XML] :> d
         <XML
             <x> <-a-> <b val=<-c->/> <-d-> </x>
         XML> pprint-xml>string
     ]
 ] unit-test
 
-[ {" <?xml version="1.0" encoding="UTF-8"?>
+{ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
 <doc>
   <item>
     one
@@ -73,36 +73,36 @@ XML-NS: foo http://blah.com
   <item>
     three
   </item>
-</doc>"} ] [
-    "one two three" " " split
+</doc>" } [
+    "one two three" split-words
     [ [XML <item><-></item> XML] ] map
     <XML <doc><-></doc> XML> pprint-xml>string
 ] unit-test
 
-[ {" <?xml version="1.0" encoding="UTF-8"?>
-<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} ]
+{ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+<x number=\"3\" url=\"http://factorcode.org/\" string=\"hello\" word=\"drop\"/>" }
 [ 3 f "http://factorcode.org/" "hello" \ drop
   <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
   pprint-xml>string  ] unit-test
 
-[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
-[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
+{ "<x>3</x>" } [ 3 [XML <x><-></x> XML] xml>string ] unit-test
+{ "<x></x>" } [ f [XML <x><-></x> XML] xml>string ] unit-test
 
 [ [XML <-> XML] ] must-infer
 [ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
 
-[ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
-[ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
-[ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
-[ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] unit-test
-[ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
-[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
+{ xml-chunk } [ [ [XML <foo/> XML] ] first class-of ] unit-test
+{ xml } [ [ <XML <foo/> XML> ] first class-of ] unit-test
+{ xml-chunk } [ [ [XML <foo val=<->/> XML] ] third class-of ] unit-test
+{ xml } [ [ <XML <foo val=<->/> XML> ] third class-of ] unit-test
+{ 1 } [ [ [XML <foo/> XML] ] length ] unit-test
+{ 1 } [ [ <XML <foo/> XML> ] length ] unit-test
 
-[ "" ] [ [XML XML] concat ] unit-test
+{ "" } [ [XML XML] concat ] unit-test
 
-[ "foo" ] [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
-[ "foo" ] [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
-[ "foo" "baz" ] [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test
+{ "foo" } [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
+{ "foo" } [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
+{ "foo" "baz" } [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test
 
 : dispatch ( xml -- string )
     {
@@ -112,13 +112,13 @@ XML-NS: foo http://blah.com
         { [ [XML <b val=<->/> XML] ] [ "bno" prepend ] }
     } switch ;
 
-[ "apple" ] [ [XML <a>pple</a> XML] dispatch ] unit-test
-[ "banana" ] [ [XML <b>anana</b> XML] dispatch ] unit-test
-[ "byes" ] [ [XML <b val="yes"/> XML] dispatch ] unit-test
-[ "bnowhere" ] [ [XML <b val="where"/> XML] dispatch ] unit-test
-[ "baboon" ] [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
-[ "apple" ] [ <XML <a>pple</a> XML> dispatch ] unit-test
-[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch ] unit-test
+{ "apple" } [ [XML <a>pple</a> XML] dispatch ] unit-test
+{ "banana" } [ [XML <b>anana</b> XML] dispatch ] unit-test
+{ "byes" } [ [XML <b val="yes"/> XML] dispatch ] unit-test
+{ "bnowhere" } [ [XML <b val="where"/> XML] dispatch ] unit-test
+{ "baboon" } [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
+{ "apple" } [ <XML <a>pple</a> XML> dispatch ] unit-test
+{ "apple" } [ <XML <a>pple</a> XML> body>> dispatch ] unit-test
 
 : dispatch-doc ( xml -- string )
     {
@@ -128,6 +128,24 @@ XML-NS: foo http://blah.com
         { [ <XML <b val=<->/> XML> ] [ "bno" prepend ] }
     } switch ;
 
-[ "apple" ] [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
-[ "apple" ] [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
-[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test
+{ "apple" } [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
+{ "apple" } [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
+{ "apple" } [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test
+
+! Make sure nested XML documents interpolate correctly
+{
+    "<?xml version=\"1.0\" encoding=\"UTF-8\"?><color><blue>it's blue!</blue></color>"
+} [
+    "it's blue!" <XML <blue><-></blue> XML>
+    <XML <color><-></color> XML> xml>string
+] unit-test
+
+{
+    "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a>asdf<asdf/>asdf2</a>"
+} [
+    default-prolog
+    "asdf"
+    "asdf" f f <tag>
+    "asdf2" <xml>
+    <XML <a><-></a> XML> xml>string
+] unit-test