2007-12-23 14:57:39 -05:00
|
|
|
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-03-01 17:00:45 -05:00
|
|
|
IN: xml.tests
|
2008-09-11 01:20:06 -04:00
|
|
|
USING: kernel xml tools.test io namespaces make sequences
|
|
|
|
|
xml.errors xml.entities parser strings xml.data io.files
|
|
|
|
|
xml.writer xml.utilities state-parser continuations assocs
|
2008-12-02 20:59:16 -05:00
|
|
|
sequences.deep accessors io.streams.string ;
|
2007-12-23 14:57:39 -05:00
|
|
|
|
|
|
|
|
! This is insufficient
|
2008-04-14 07:04:01 -04:00
|
|
|
\ read-xml must-infer
|
|
|
|
|
|
2007-12-23 14:57:39 -05:00
|
|
|
SYMBOL: xml-file
|
2008-07-28 23:03:13 -04:00
|
|
|
[ ] [ "resource:basis/xml/tests/test.xml"
|
2007-12-23 14:57:39 -05:00
|
|
|
[ file>xml ] with-html-entities xml-file set ] unit-test
|
2008-08-28 18:23:33 -04:00
|
|
|
[ "1.0" ] [ xml-file get prolog>> version>> ] unit-test
|
|
|
|
|
[ f ] [ xml-file get prolog>> standalone>> ] unit-test
|
|
|
|
|
[ "a" ] [ xml-file get space>> ] unit-test
|
|
|
|
|
[ "http://www.hello.com" ] [ xml-file get url>> ] unit-test
|
2007-12-23 14:57:39 -05:00
|
|
|
[ "that" ] [
|
|
|
|
|
xml-file get T{ name f "" "this" "http://d.de" } swap at
|
|
|
|
|
] unit-test
|
2008-08-28 18:23:33 -04:00
|
|
|
[ t ] [ xml-file get children>> second contained-tag? ] unit-test
|
2008-02-06 14:47:19 -05:00
|
|
|
[ "<a></b>" string>xml ] [ xml-parse-error? ] must-fail-with
|
2007-12-23 14:57:39 -05:00
|
|
|
[ T{ comment f "This is where the fun begins!" } ] [
|
2008-09-01 22:36:34 -04:00
|
|
|
xml-file get before>> [ comment? ] find nip
|
2007-12-23 14:57:39 -05:00
|
|
|
] unit-test
|
|
|
|
|
[ "xsl stylesheet=\"that-one.xsl\"" ] [
|
2008-08-28 18:23:33 -04:00
|
|
|
xml-file get after>> [ instruction? ] find nip text>>
|
2007-12-23 14:57:39 -05:00
|
|
|
] unit-test
|
2008-08-28 18:23:33 -04:00
|
|
|
[ V{ "fa&g" } ] [ xml-file get "x" get-id children>> ] unit-test
|
2007-12-23 14:57:39 -05:00
|
|
|
[ "that" ] [ xml-file get "this" swap at ] unit-test
|
2008-03-25 22:45:26 -04:00
|
|
|
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a b=\"c\"/>" ]
|
2007-12-23 14:57:39 -05:00
|
|
|
[ "<a b='c'/>" string>xml xml>string ] unit-test
|
|
|
|
|
[ "abcd" ] [
|
|
|
|
|
"<main>a<sub>bc</sub>d<nothing/></main>" string>xml
|
|
|
|
|
[ [ dup string? [ % ] [ drop ] if ] deep-each ] "" make
|
|
|
|
|
] unit-test
|
|
|
|
|
[ "abcd" ] [
|
|
|
|
|
"<main>a<sub>bc</sub>d<nothing/></main>" string>xml
|
2008-04-26 00:17:08 -04:00
|
|
|
[ string? ] deep-filter concat
|
2007-12-23 14:57:39 -05:00
|
|
|
] unit-test
|
|
|
|
|
[ "foo" ] [
|
|
|
|
|
"<a><b id='c'>foo</b><d id='e'/></a>" string>xml
|
|
|
|
|
"c" get-id children>string
|
|
|
|
|
] unit-test
|
|
|
|
|
[ "foo" ] [ "<x y='foo'/>" string>xml "y" over
|
2008-12-02 20:59:16 -05:00
|
|
|
at swap "z" [ tuck ] dip swap set-at
|
2007-12-23 14:57:39 -05:00
|
|
|
T{ name f "blah" "z" f } swap at ] unit-test
|
2007-10-12 16:28:23 -04:00
|
|
|
[ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
|
2008-03-25 22:45:26 -04:00
|
|
|
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>bar baz</foo>" ]
|
2007-12-23 14:57:39 -05:00
|
|
|
[ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
|
2008-03-25 22:45:26 -04:00
|
|
|
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ]
|
2007-12-29 01:33:21 -05:00
|
|
|
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
|
2008-12-02 20:59:16 -05:00
|
|
|
[ "<!-- B+, B, or B--->" string>xml ] must-fail
|
|
|
|
|
[ ] [ "<?xml version='1.0'?><!-- declarations for <head> & <body> --><foo/>" string>xml drop ] unit-test
|
|
|
|
|
[ T{ element-decl f "br" "EMPTY" } ] [ "<!ELEMENT br EMPTY>" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ element-decl f "p" "(#PCDATA|emph)*" } ] [ "<!ELEMENT p (#PCDATA|emph)*>" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ element-decl f "%name.para;" "%content.para;" } ] [ "<!ELEMENT %name.para; %content.para;>" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ element-decl f "container" "ANY" } ] [ "<!ELEMENT container ANY>" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ doctype-decl f "foo" } ] [ "<!DOCTYPE foo>" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ doctype-decl f "foo" } ] [ "<!DOCTYPE foo >" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo SYSTEM 'blah.dtd'>" string>xml-chunk second ] unit-test
|
|
|
|
|
[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo SYSTEM \"blah.dtd\" >" string>xml-chunk second ] unit-test
|
