Wiki

(* Module: Test_Xml Provides unit tests and examples for the lens. *) module Test_Xml = (* View: knode A simple flag function Parameters: r:regexp - the pattern for the flag *) let knode (r:regexp) = [ key r ] (************************************************************************ * Group: Utilities lens *************************************************************************) (* let _ = print_regexp(lens_ctype(Xml.text)) let _ = print_endline "" *) (* Group: Comments *) (* Test: Xml.comment Comments get mapped into "#comment" nodes. *) test Xml.comment get "" = { "#comment" = " declarations for & " } (* Test: Xml.comment This syntax is not understood. *) test Xml.comment get "" = * (* Group: Prolog and declarations *) (* Test: Xml.prolog The XML prolog tag is mapped in a "#declaration" node, which contains an "#attribute" node with various attributes of the tag. *) test Xml.prolog get "" = { "#declaration" { "#attribute" { "version" = "1.0" } { "encoding" = "UTF-8" } } } (* Test: Xml.decl_def_item !ELEMENT declaration tags are mapped in "!ELEMENT" nodes. The associated declaration attribute is mapped in a "#decl" subnode. *) test Xml.decl_def_item get "" = { "!ELEMENT" = "greeting" { "#decl" = "(#PCDATA)" } } (* Test: Xml.decl_def_item !ENTITY declaration tags are mapped in "!ENTITY" nodes. The associated declaration attribute is mapped in a "#decl" subnode. *) test Xml.decl_def_item get "" = { "!ENTITY" = "da" { "#decl" = " " } } (* Test: Xml.doctype !DOCTYPE tags are mapped in "!DOCTYPE" nodes. The associated system attribute is mapped in a "SYSTEM" subnode. *) test Xml.doctype get "" = { "!DOCTYPE" = "greeting:foo" { "SYSTEM" = "hello.dtd" } } (* Test: Xml.doctype This is an example of a !DOCTYPE tag with !ELEMENT children tags. *) test Xml.doctype get " ]>" = { "!DOCTYPE" = "foo" { "!ELEMENT" = "bar" { "#decl" = "(#PCDATA)" } } { "!ELEMENT" = "baz" { "#decl" = "(bar)*" } } } (* Group: Attributes *) (* Variable: att_def1 *) let att_def1 = "" (* Variable: att_def2 *) let att_def2 = "" (* Variable: att_def3 *) let att_def3 = "" (* Test: Xml.att_list_def *) test Xml.att_list_def get att_def1 = { "!ATTLIST" = "termdef" { "1" { "#name" = "id" } { "#type" = "ID" } { "#REQUIRED" } } { "2" { "#name" = "name" } { "#type" = "CDATA" } { "#IMPLIED" } } } (* Test: Xml.att_list_def *) test Xml.att_list_def get att_def2 = { "!ATTLIST" = "list" { "1" { "#name" = "type" } { "#type" = "(bullets|ordered|glossary)" } { "#FIXED" = "ordered" } } } (* Test: Xml.att_list_def *) test Xml.att_list_def get att_def3 = { "!ATTLIST" = "form" { "1" { "#name" = "method" } { "#type" = "CDATA" } { "#FIXED" = "POST" } } } (* Test: Xml.notation_def *) test Xml.notation_def get "" = { "!NOTATION" = "not3" { "SYSTEM" = "" } } (* Variable: cdata1 *) let cdata1 = "" (* Test: Xml.cdata *) test Xml.cdata get cdata1 = { "#CDATA" = "testing" } (* Variable: attr1 *) let attr1 = " attr1=\"value1\" attr2=\"value2\"" (* Variable: attr2 *) let attr2 = " attr2=\"foo\"" (* Test: Xml.attributes *) test Xml.attributes get attr1 = { "#attribute" { "attr1" = "value1" } { "attr2" = "value2" } } (* Test: Xml.attributes *) test Xml.attributes get " refs=\"A1\nA2 A3\"" = { "#attribute" { "refs" = "A1\nA2 A3" } } (* Test: Xml.attributes *) test Xml.attributes put attr1 after rm "/#attribute[1]"; set "/#attribute/attr2" "foo" = attr2 (* test quoting *) (* well formed values *) test Xml.attributes get " attr1=\"value1\"" = { "#attribute" { "attr1" = "value1" } } test Xml.attributes get " attr1='value1'" = { "#attribute" { "attr1" = "value1" } } test Xml.attributes get " attr1='va\"lue1'" = { "#attribute" { "attr1" = "va\"lue1" } } test Xml.attributes get " attr1=\"va'lue1\"" = { "#attribute" { "attr1" = "va'lue1" } } (* illegal as per the XML standard *) test Xml.attributes get " attr1=\"va\"lue1\"" = * test Xml.attributes get " attr1='va'lue1'" = * (* malformed values *) test Xml.attributes get " attr1=\"value1'" = * test Xml.attributes get " attr1='value1\"" = * (* Group: empty *) (* Variable: empty1 *) let empty1 = "" (* Variable: empty2 *) let empty2 = "" (* Variable: empty3 *) let empty3 = "\n" (* Variable: empty4 *) let empty4 = "" (* Test: Xml.empty_element *) test Xml.empty_element get empty1 = { "a" = "#empty" } (* Test: Xml.empty_element *) test Xml.empty_element get empty2 = { "a" = "#empty" { "#attribute" { "foo" = "bar"} } } (* Test: Xml.empty_element *) test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar" = empty2 (* Test: Xml.empty_element The attribute node must be the first child of the element *) test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar"; set "/a/#attribute/far" "baz" = empty4 (* Test: Xml.content *) test Xml.content put "" after clear "/a/b" = "\n" (* Group: Full lens *) (* Test: Xml.lns *) test Xml.lns put "" after set "/a/#text[1]" "foo"; set "/a/#text[2]" "bar" = "foobar" (* Test: Xml.lns *) test Xml.lns get " " = { "#declaration" { "#attribute" { "version" = "1.0" } } } { "!DOCTYPE" = "catalog" { "PUBLIC" { "#literal" = "-//OASIS//DTD XML Catalogs V1.0//EN" } { "#literal" = "file:///usr/share/xml/schema/xml-core/catalog.dtd" } } } { "doc" = "#empty" } (* Test: Xml.lns *) test Xml.lns get " " = { "oor:component-data" = "#empty" { "#attribute" { "xmlns:oor" = "http://openoffice.org/2001/registry" } } } (* Variable: input1 *) let input1 = " \r Wiki
Augeas

Augeas is now able to parse XML files!

Translate from XML to a tree syntax

Translate from the tree back to XML

this

" (* Test: Xml.doc Test with *) test Xml.doc get input1 = { "#declaration" { "#attribute" { "version" = "1.0" } { "encoding" = "UTF-8" } } } { "html" { "#text" = "\r\n " } { "head" { "#text" = "\n " } { "title" { "#text" = "Wiki" } } { "#text" = " " } } { "#text" = " " } { "body" { "#text" = " " } { "h1" { "#text" = "Augeas" } } { "#text" = " " } { "p" { "#attribute" { "class" = "main" } } { "#text" = "Augeas is now able to parse XML files!" } } { "#text" = " " } { "ul" { "#text" = "\n " } { "li" { "#text" = "Translate from XML to a tree syntax" } } { "#text" = " " } { "li" { "#text" = "Translate from the tree back to XML" } } { "#text" = " " } { "#comment" = " this is some comment " } { "#text" = " " } { "li" { "#text" = "this" } } { "#text" = " " } } { "#text" = " " } } } (* Test: Xml.doc Modify with *) test Xml.doc put input1 after rm "/html/body" = " \r Wiki " (* Variable: ul1 *) let ul1 = "

test1

test2

test3

test4

" test Xml.doc get ul1 = { "ul" { "#text" = " " } { "li" { "#text" = "test1" } } { "#text" = " " } { "li" { "#text" = "test2" } } { "#text" = " " } { "li" { "#text" = "test3" } } { "#text" = " " } { "li" { "#text" = "test4" } } } test Xml.doc put ul1 after set "/ul/li[3]/#text" "bidon" = "

test1

test2

bidon

test4

" test Xml.doc put ul1 after rm "/ul/li[2]" = "

test1

test3

test4

" (* #text nodes don't move when inserting a node, the result depends on where the node is added *) test Xml.doc put ul1 after insb "a" "/ul/li[2]" = "

test1

test2

test3

test4

" test Xml.doc put ul1 after insa "a" "/ul/li[1]" = "

test1

test2

test3

test4

" (* Attributes must be added before text nodes *) test Xml.doc put ul1 after insb "#attribute" "/ul/li[2]/#text"; set "/ul/li[2]/#attribute/bidon" "gazou"; set "/ul/li[2]/#attribute/foo" "bar" = "

test1

test2

test3

test4

" (* if empty element is allowed to be as root, this test triggers error *) test Xml.lns get " " = { "doc" { "#text" = "\n" } { "a" { "c" = "#empty" } { "b" { "c" = "#empty" } } { "c" = "#empty" } { "c" = "#empty" } { "a" } } } let p01pass2 = " ]> " test Xml.lns get p01pass2 = { "#pi" { "#target" = "PI" } { "#instruction" = "before document element" } } { "#comment" = " comment after document element" } { "#pi" { "#target" = "PI" } { "#instruction" = "before document element" } } { "#comment" = " comment after document element" } { "#pi" { "#target" = "PI" } { "#instruction" = "before document element" } } { "#comment" = " comment after document element" } { "#pi" { "#target" = "PI" } { "#instruction" = "before document element" } } { "!DOCTYPE" = "doc" { "!ELEMENT" = "doc" { "#decl" = "ANY" } } { "!ELEMENT" = "a" { "#decl" = "ANY" } } { "!ELEMENT" = "b" { "#decl" = "ANY" } } { "!ELEMENT" = "c" { "#decl" = "ANY" } } } { "doc" { "#text" = " " } { "a" { "b" { "c" = "#empty" } } } } { "#comment" = " comment after document element" } { "#pi" { "#target" = "PI" } { "#instruction" = "after document element" } } { "#comment" = " comment after document element" } { "#pi" { "#target" = "PI" } { "#instruction" = "after document element" } } { "#comment" = " comment after document element" } { "#pi" { "#target" = "PI" } { "#instruction" = "after document element" } } (* various valid Name constructions *) test Xml.lns get "\n\n<::._-0/>\n<_:._-0/>\n\n<_/>\n<:/>\n" = { "doc" { "#text" = "\n" } { "A:._-0" = "#empty" } { "::._-0" = "#empty" } { "_:._-0" = "#empty" } { "A" = "#empty" } { "_" = "#empty" } { ":" = "#empty" } } test Xml.lns get " " = { "doc" { "#text" = "\n" } { "abcdefghijklmnopqrstuvwxyz" = "#empty" } { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" = "#empty" } { "A01234567890" = "#empty" } { "A.-:" = "#empty" } } let p06fail1 = " ]> " (* we accept this test because we do not verify XML references *) test Xml.lns get p06fail1 = { "#comment" = "non-validating processors may pass this instance because they don't check the IDREFS attribute type" } { "!DOCTYPE" = "doc" { "!ELEMENT" = "doc" { "#decl" = "(a|refs)*" } } { "!ELEMENT" = "a" { "#decl" = "EMPTY" } } { "!ELEMENT" = "refs" { "#decl" = "EMPTY" } } { "!ATTLIST" = "refs" { "1" { "#name" = "refs" } { "#type" = "IDREFS" } { "#REQUIRED" } } } { "!ATTLIST" = "a" { "1" { "#name" = "id" } { "#type" = "ID" } { "#REQUIRED" } } } } { "doc" { "#text" = " " } { "a" = "#empty" { "#attribute" { "id" = "A1" } } } { "a" = "#empty" { "#attribute" { "id" = "A2" } } } { "a" = "#empty" { "#attribute" { "id" = "A3" } } } { "refs" = "#empty" { "#attribute" { "refs" = "" } } } } (* we accept dquote, but not single quotes, because of resulting ambiguity *) let p10pass1_1 = "'">\nasdf\n ?>%\"/>" let p10pass1_2 = "" test Xml.lns get p10pass1_1 = { "doc" { "A" = "#empty" { "#attribute" { "a" = "asdf>'">\nasdf\n ?>%" } } } } test Xml.lns get p10pass1_2 = { "doc" { "A" = "#empty" { "#attribute" { "a" = "\"\">'"" } } } } (* here again, test exclude single quote *) let p11pass1 = " ?>/\''\"> ]> " test Xml.lns get p11pass1 = { "#comment" = "Inability to resolve a notation should not be reported as an error" } { "!DOCTYPE" = "doc" { "!ELEMENT" = "doc" { "#decl" = "EMPTY" } } { "!NOTATION" = "not1" { "SYSTEM" = "a%a&b�?>/\''" } } { "!NOTATION" = "not3" { "SYSTEM" = "" } } } { "doc" } test Xml.lns get "a%b%</doc></doc>]]<&" = { "doc" { "#text" = "a%b%</doc></doc>]]<&" } } let p15pass1 = " " test Xml.lns get p15pass1 = { "#comment" = "a -<[ CDATA [ \"- -'- -" } { "#comment" = "" } { "doc" } let p22pass3 = " " test Xml.lns get p22pass3 = { "#declaration" { "#attribute" { "version" = "1.0" } } } { "#comment" = "comment" } { "#pi" { "#target" = "pi" } { "#instruction" = "some instruction" } } { "doc" { "#pi" { "#target" = "pi" } } } let p25pass2 = " " test Xml.lns get p25pass2 = { "#declaration" { "#attribute" { "version" = "1.0" } } } { "doc" } test Xml.lns get " ]> " = { "!DOCTYPE" = "doc" { "!ELEMENT" = "doc" { "#decl" = "EMPTY" } } } { "doc" } test Xml.lns get "" = { "doc" } test Xml.lns get "" = { "a" { "doc" = "#empty" { "#attribute" { "att" = "val" } { "att2" = "val2" } { "att3" = "val3" } } } } test Xml.lns get "" = { "doc" = "#empty" } test Xml.lns get "" = { "a" { "#CDATA" = "Thu, 13 Feb 2014 12:22:35 +0000" } } (* failure tests *) (* only one document element *) test Xml.lns get "" = * (* document element must be complete *) test Xml.lns get "" = * (* accept empty document *) test Xml.lns get "\n" = {} (* malformed element *) test Xml.lns get "" = * (* a Name cannot start with a digit *) test Xml.lns get "<0A/>" = * (* no space before "CDATA" *) test Xml.lns get "" = * (* no space after "CDATA" *) test Xml.lns get "" = * (* FIXME: CDSect's can't nest *) test Xml.lns get " ]]> " = { "doc" { "#text" = "\n" } { "#CDATA" = "\n\n" } } (* Comment is illegal in VersionInfo *) test Xml.lns get " =\"1.0\"?> " = * (* only declarations in DTD *) test Xml.lns get " ]>" = * (* we do not support external entities *) test Xml.lns get "\"> %eldecl; ]> " = * (* Escape character in attributes *) test Xml.lns get "" = { "a" = "#empty" { "#attribute" { "password" = "my\!pass" } } } test Xml.lns put "" after set "/a" "#empty" = "\n" (* Issue #142 *) test Xml.entity_def get "" = { "!ENTITY" = "open-hatch" { "SYSTEM" { "#systemliteral" = "http://examplecom/OpenHatch.xml" } } } test Xml.entity_def get "" = { "!ENTITY" = "open-hatch" { "PUBLIC" { "#pubidliteral" = "-//Textuality//TEXT Standard open-hatch boilerplate//EN" } { "#systemliteral" = "http://www.textuality.com/boilerplate/OpenHatch.xml" } } } let dt_with_entities = " ]>" test Xml.doctype get dt_with_entities = { "!DOCTYPE" = "server-xml" { "!ENTITY" = "sys-ent" { "SYSTEM" { "#systemliteral" = "sys-file.xml" } } } { "!ENTITY" = "pub-ent" { "PUBLIC" { "#pubidliteral" = "-//something public//TEXT" } { "#systemliteral" = "pub-file.xml" } } } } test Xml.doctype put dt_with_entities after rm "/\!DOCTYPE/\!ENTITY[2]"; set "/\!DOCTYPE/\!ENTITY[. = \"sys-ent\"]/SYSTEM/#systemliteral" "other-file.xml" = " ]>" test Xml.lns get (dt_with_entities . "") = { "!DOCTYPE" = "server-xml" { "!ENTITY" = "sys-ent" { "SYSTEM" { "#systemliteral" = "sys-file.xml" } } } { "!ENTITY" = "pub-ent" { "PUBLIC" { "#pubidliteral" = "-//something public//TEXT" } { "#systemliteral" = "pub-file.xml" } } } } { "body" } test Xml.lns put " " after insa "!DOCTYPE" "#declaration"; set "\\!DOCTYPE" "Server"; set "\\!DOCTYPE/\\!ENTITY" "resourcesFile"; set "\\!DOCTYPE/\\!ENTITY/SYSTEM/#systemliteral" "data.xml" = "]> \n"