factor/basis/xml/tests/test.factor

! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
IN: xml.tests
USING: kernel xml tools.test io namespaces make sequences
xml.errors xml.entities.html parser strings xml.data io.files
xml.traversal continuations assocs io.encodings.binary
sequences.deep accessors io.streams.string ;

! This is insufficient
[ [ drop ] each-element ] must-infer

SYMBOL: xml-file
[ ] [
    "vocab:xml/tests/test.xml"
    [ file>xml ] with-html-entities xml-file set
] unit-test
[ t ] [
    "vocab:xml/tests/test.xml" binary file-contents
    [ bytes>xml ] with-html-entities xml-file get =
] unit-test
[ "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
[ "that" ] [
    xml-file get T{ name f "" "this" "http://d.de" } attr
] unit-test
[ t ] [ xml-file get children>> second contained-tag? ] unit-test
[ "<a></b>" string>xml ] [ xml-error? ] must-fail-with
[ T{ comment f "This is where the fun begins!" } ] [
    xml-file get before>> [ comment? ] find nip
] unit-test
[ "xsl stylesheet=\"that-one.xsl\"" ] [
    xml-file get after>> [ instruction? ] find nip text>>
] unit-test
[ V{ "fa&g" } ] [ xml-file get "x" get-id children>> ] unit-test
[ "that" ] [ xml-file get "this" attr ] 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
    [ string? ] deep-filter concat
] 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
    dup dup "y" attr "z" set-attr
    T{ name { space "blah" } { main "z" } } attr
] unit-test
[ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
[ "<!-- B+, B, or B--->" string>xml ] must-fail
[ ] [ "<?xml version='1.0'?><!-- declarations for <head> & <body> --><foo/>" string>xml drop ] unit-test

: first-thing ( seq -- elt )
    [ "" = not ] filter first ;

[ T{ element-decl f "br" "EMPTY" } ] [ "<!ELEMENT br EMPTY>" string>dtd directives>> first-thing ] unit-test
[ T{ element-decl f "p" "(#PCDATA|emph)*" } ] [ "<!ELEMENT p (#PCDATA|emph)*>" string>dtd directives>> first-thing ] unit-test
[ T{ element-decl f "%name.para;" "%content.para;" } ] [ "<!ELEMENT %name.para; %content.para;>" string>dtd directives>> first-thing ] unit-test
[ T{ element-decl f "container" "ANY" } ] [ "<!ELEMENT container ANY>" string>dtd directives>> first-thing ] unit-test
[ T{ doctype-decl f "foo" } ] [ "<!DOCTYPE foo>" string>xml-chunk first-thing ] unit-test
[ T{ doctype-decl f "foo" } ] [ "<!DOCTYPE foo >" string>xml-chunk first-thing ] unit-test
[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo SYSTEM 'blah.dtd'>" string>xml-chunk first-thing ] unit-test
[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo   SYSTEM \"blah.dtd\"   >" string>xml-chunk first-thing ] unit-test
[ 958 ] [ [ "&xi;" string>xml-chunk ] with-html-entities first first ] unit-test
[ "x" "<" ] [ "<x value='&lt;'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
[ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test
[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
[ "1.1" ] [ "<?xml version='1.1'?><x/>" string>xml prolog>> version>> ] unit-test
[ "ß" ] [ "<x>ß</x>" <string-reader> read-xml children>string ] unit-test

! <pull-xml> tests
! this tests just checks that pull-event doesn't raise an exception
[ ] [ "vocab:xml/tests/test.xml" binary [ <pull-xml> pull-event drop ] with-file-reader ] unit-test
Code using interpolation can now compile 2009-01-27 15:33:43 -05:00			`! Copyright (C) 2005, 2009 Daniel Ehrenberg`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`! See http://factorcode.org/license.txt for BSD license.`
New convention for unit tests 2008-03-01 17:00:45 -05:00			`IN: xml.tests`
Fixing unit tests for make, fry changes 2008-09-11 01:20:06 -04:00			`USING: kernel xml tools.test io namespaces make sequences`
XML parses entities now 2009-01-15 23:20:24 -05:00			`xml.errors xml.entities.html parser strings xml.data io.files`
Making xml-undo words private; adding bytes>xml word 2009-02-13 16:10:34 -05:00			`xml.traversal continuations assocs io.encodings.binary`
Update XML library to parse <! directives better; modernize the code a bit 2008-12-02 20:59:16 -05:00			`sequences.deep accessors io.streams.string ;`
XML combinator refactoring 2007-12-23 14:57:39 -05:00
			`! This is insufficient`
Documenting read-dtd and friends; renaming sax to each-element 2009-01-27 15:15:00 -05:00			`[ [ drop ] each-element ] must-infer`
Fixing minor bugs 2008-04-14 07:04:01 -04:00
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`SYMBOL: xml-file`
Making xml-undo words private; adding bytes>xml word 2009-02-13 16:10:34 -05:00			`[ ] [`
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`"vocab:xml/tests/test.xml"`
Making xml-undo words private; adding bytes>xml word 2009-02-13 16:10:34 -05:00			`[ file>xml ] with-html-entities xml-file set`
			`] unit-test`
			`[ t ] [`
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`"vocab:xml/tests/test.xml" binary file-contents`
Making xml-undo words private; adding bytes>xml word 2009-02-13 16:10:34 -05:00			`[ bytes>xml ] with-html-entities xml-file get =`
			`] unit-test`
Fixing some XML unit tests 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`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`[ "that" ] [`
XML chunks are a separate datatype; XML tags are no longer assocs 2009-01-28 15:33:33 -05:00			`xml-file get T{ name f "" "this" "http://d.de" } attr`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`] unit-test`
Fixing some XML unit tests 2008-08-28 18:23:33 -04:00			`[ t ] [ xml-file get children>> second contained-tag? ] unit-test`
Documentation, unit tests for XML 2009-01-26 17:11:30 -05:00			`[ "<a></b>" string>xml ] [ xml-error? ] must-fail-with`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`[ T{ comment f "This is where the fun begins!" } ] [`
new accessor 2008-09-01 22:36:34 -04:00			`xml-file get before>> [ comment? ] find nip`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`] unit-test`
			`[ "xsl stylesheet=\"that-one.xsl\"" ] [`
Fixing some XML unit tests 2008-08-28 18:23:33 -04:00			`xml-file get after>> [ instruction? ] find nip text>>`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`] unit-test`
Fixing some XML unit tests 2008-08-28 18:23:33 -04:00			`[ V{ "fa&g" } ] [ xml-file get "x" get-id children>> ] unit-test`
XML chunks are a separate datatype; XML tags are no longer assocs 2009-01-28 15:33:33 -05:00			`[ "that" ] [ xml-file get "this" attr ] unit-test`
XML combinator refactoring 2007-12-23 14:57:39 -05:00			`[ "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`
extra changes: index* -> index-from last-index* -> last-index-from 1 tail -> rest 1 tail-slice -> rest-slice subset -> filter prepose find* -> find-from find-last* -> find-last-from before, after generic, < for integers make between? work for timestamps 2008-04-26 00:17:08 -04:00			`[ string? ] deep-filter concat`
XML combinator refactoring 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`
XML chunks are a separate datatype; XML tags are no longer assocs 2009-01-28 15:33:33 -05:00			`[ "foo" ] [`
			`"<x y='foo'/>" string>xml`
			`dup dup "y" attr "z" set-attr`
			`T{ name { space "blah" } { main "z" } } attr`
			`] unit-test`
Fixed CDATA parsing bug 2007-10-12 16:28:23 -04:00			`[ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test`
Update XML library to parse <! directives better; modernize the code a bit 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`
Code cleanup in XML 2009-01-29 17:57:13 -05:00
			`: first-thing ( seq -- elt )`
			`[ "" = not ] filter first ;`

			`[ T{ element-decl f "br" "EMPTY" } ] [ "<!ELEMENT br EMPTY>" string>dtd directives>> first-thing ] unit-test`
			`[ T{ element-decl f "p" "(#PCDATA\|emph)" } ] [ "<!ELEMENT p (#PCDATA\|emph)>" string>dtd directives>> first-thing ] unit-test`
			`[ T{ element-decl f "%name.para;" "%content.para;" } ] [ "<!ELEMENT %name.para; %content.para;>" string>dtd directives>> first-thing ] unit-test`
			`[ T{ element-decl f "container" "ANY" } ] [ "<!ELEMENT container ANY>" string>dtd directives>> first-thing ] unit-test`
			`[ T{ doctype-decl f "foo" } ] [ "<!DOCTYPE foo>" string>xml-chunk first-thing ] unit-test`
			`[ T{ doctype-decl f "foo" } ] [ "<!DOCTYPE foo >" string>xml-chunk first-thing ] unit-test`
			`[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo SYSTEM 'blah.dtd'>" string>xml-chunk first-thing ] unit-test`
			`[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo SYSTEM \"blah.dtd\" >" string>xml-chunk first-thing ] unit-test`
Various XML fixes, XML test suite 2009-01-19 23:25:15 -05:00			`[ 958 ] [ [ "ξ" string>xml-chunk ] with-html-entities first first ] unit-test`
XML chunks are a separate datatype; XML tags are no longer assocs 2009-01-28 15:33:33 -05:00			`[ "x" "<" ] [ "<x value='<'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test`
Separating out reading DTDs 2009-01-22 17:31:22 -05:00			`[ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test`
XML chunks are a separate datatype; XML tags are no longer assocs 2009-01-28 15:33:33 -05:00			`[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test`
Fixing bug in XML where prolog isn't considered; whenever you write XML, the encoding is listed as UTF-8. 2009-02-04 13:32:47 -05:00			`[ "1.1" ] [ "<?xml version='1.1'?><x/>" string>xml prolog>> version>> ] unit-test`
Cleaning up XML to make : string>xml <string-reader> read-xml ; 2009-03-16 19:28:15 -04:00			`[ "ß" ] [ "<x>ß</x>" <string-reader> read-xml children>string ] unit-test`
basis.xml: Add test to check that pull-event doesn't raise an exception when called on a pull-xml object 2009-07-22 19:48:38 -04:00
			`! <pull-xml> tests`
			`! this tests just checks that pull-event doesn't raise an exception`
			`[ ] [ "vocab:xml/tests/test.xml" binary [ <pull-xml> pull-event drop ] with-file-reader ] unit-test`