basis/xml/tests/test.factor

   1 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: xml.tests
   4 USING: kernel xml tools.test io namespaces sequences xml.errors xml.entities
   5     parser strings xml.data io.files xml.writer xml.utilities state-parser
   6     continuations assocs sequences.deep ;
   7
   8 ! This is insufficient
   9 \ read-xml must-infer
  10
  11 SYMBOL: xml-file
  12 [ ] [ "resource:basis/xml/tests/test.xml"
  13     [ file>xml ] with-html-entities xml-file set ] unit-test
  14 [ "1.0" ] [ xml-file get xml-prolog prolog-version ] unit-test
  15 [ f ] [ xml-file get xml-prolog prolog-standalone ] unit-test
  16 [ "a" ] [ xml-file get name-space ] unit-test
  17 [ "http://www.hello.com" ] [ xml-file get name-url ] unit-test
  18 [ "that" ] [
  19     xml-file get T{ name f "" "this" "http://d.de" } swap at
  20 ] unit-test
  21 [ t ] [ xml-file get tag-children second contained-tag? ] unit-test
  22 [ "<a></b>" string>xml ] [ xml-parse-error? ] must-fail-with
  23 [ T{ comment f "This is where the fun begins!" } ] [
  24     xml-file get xml-before [ comment? ] find nip
  25 ] unit-test
  26 [ "xsl stylesheet=\"that-one.xsl\"" ] [
  27     xml-file get xml-after [ instruction? ] find nip instruction-text
  28 ] unit-test
  29 [ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test
  30 [ "that" ] [ xml-file get "this" swap at ] unit-test
  31 [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a b=\"c\"/>" ]
  32     [ "<a b='c'/>" string>xml xml>string ] unit-test
  33 [ "abcd" ] [
  34     "<main>a<sub>bc</sub>d<nothing/></main>" string>xml
  35     [ [ dup string? [ % ] [ drop ] if ] deep-each ] "" make
  36 ] unit-test
  37 [ "abcd" ] [
  38     "<main>a<sub>bc</sub>d<nothing/></main>" string>xml
  39     [ string? ] deep-filter concat
  40 ] unit-test
  41 [ "foo" ] [
  42     "<a><b id='c'>foo</b><d id='e'/></a>" string>xml
  43     "c" get-id children>string
  44 ] unit-test
  45 [ "foo" ] [ "<x y='foo'/>" string>xml "y" over
  46     at swap "z" >r tuck r> swap set-at
  47     T{ name f "blah" "z" f } swap at ] unit-test
  48 [ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
  49 [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>bar baz</foo>" ]
  50 [ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
  51 [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n  bar\n</foo>" ]
  52 [ "<foo>         bar            </foo>" string>xml pprint-xml>string ] unit-test