Hi,
The square lens, required for handling tag based document, is ready. I
tested it with the Xml lens, that pushed the bundaries for this new lens
primitive.
In order to test the lens, I used many tests that comes from the Oasis
XML conformity testing framework.
The XML lens parse arbitrary XML documents. Most, but not all features
of XML standard are implemented, partially because the nature of augeas.
Supported:
* Document type declaration: elements, attlist, entity
* XML Prolog
* XML comments
* XML processing instructions
* Neested elements, including empty elements
* Element attributes
* Mixed content, text and elements
* CDATA sections
Not supported:
* External entity reference, because augeas can't load a related
file within a lens
* Document validation: augeas don't enforce DTD
This lens doesn't respect the PutGet law, becuse of an ambiguity in
union.put with text nodes. If a text node is created as a sibling of
another text node, a put and a get will merge those two nodes. In
practice, no error occur and this is a desirable behavior.
I'm ready to commit it to master branch, but first, I would like
approbation, and if you think of other files to load with this lens, I
would like to know it. (for example, there are OpenOffice files in /usr,
but I don't find overloading ones in /etc...)
Cheer,
Francis
module Test_xml =
let knode (r:regexp) = [ key r ]
(************************************************************************
* Utilities lens
*************************************************************************)
(*
let _ = print_regexp(lens_ctype(Xml.text))
let _ = print_endline ""
*)
test Xml.comment get "<!-- declarations for <head> & <body> -->" =
{ "#comment" = " declarations for <head> & <body> " }
test Xml.comment get "<!-- B+, B, or B--->" = *
test Xml.prolog get "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" =
{ "#declaration"
{ "#attribute"
{ "version" = "1.0" }
{ "encoding" = "UTF-8" }
}
}
test Xml.decl_def_item get "<!ELEMENT greeting (#PCDATA)>" =
{ "!ELEMENT" = "greeting"
{ "#decl" = "(#PCDATA)" }
}
test Xml.decl_def_item get "<!ENTITY da \"
\">" =
{ "!ENTITY" = "da"
{ "#decl" = "
" }
}
test Xml.doctype get "<!DOCTYPE greeting SYSTEM \"hello.dtd\">" =
{ "!DOCTYPE" = "greeting"
{ "SYSTEM" = "hello.dtd" }
}
test Xml.doctype get "<!DOCTYPE foo [
<!ELEMENT bar (#PCDATA)>
<!ELEMENT baz (bar)* >
]>" =
{ "!DOCTYPE" = "foo"
{ "!ELEMENT" = "bar"
{ "#decl" = "(#PCDATA)" }
}
{ "!ELEMENT" = "baz"
{ "#decl" = "(bar)*" }
}
}
let att_def1 = "<!ATTLIST termdef
id ID #REQUIRED
name CDATA #IMPLIED>"
let att_def2 = "<!ATTLIST list
type (bullets|ordered|glossary) \"ordered\">"
let att_def3 = "<!ATTLIST form
method CDATA #FIXED \"POST\">"
test Xml.att_list_def get att_def1 =
{ "!ATTLIST" = "termdef"
{
{ "#name" = "id" }
{ "#type" = "ID" }
{ "#REQUIRED" }
}
{
{ "#name" = "name" }
{ "#type" = "CDATA" }
{ "#IMPLIED" }
}
}
test Xml.att_list_def get att_def2 =
{ "!ATTLIST" = "list"
{
{ "#name" = "type" }
{ "#type" = "(bullets|ordered|glossary)" }
{ "#FIXED" = "ordered" }
}
}
test Xml.att_list_def get att_def3 =
{ "!ATTLIST" = "form"
{
{ "#name" = "method" }
{ "#type" = "CDATA" }
{ "#FIXED" = "POST" }
}
}
test Xml.notation_def get "<!NOTATION not3 SYSTEM \"\">" =
{ "!NOTATION" = "not3"
{ "SYSTEM"
{ "#literal" = "" }
}
}
let cdata1 = "<![CDATA[testing]]>"
test Xml.cdata get cdata1 = { "#CDATA" = "testing" }
let attr1 = " attr1=\"value1\" attr2=\"value2\""
let attr2 = " attr2=\"foo\""
test Xml.attributes get attr1 =
{ "#attribute"
{ "attr1" = "value1" }
{ "attr2" = "value2" }
}
test Xml.attributes get " refs=\"A1\nA2 A3\"" =
{ "#attribute"
{ "refs" = "A1\nA2 A3" }
}
test Xml.attributes put attr1 after rm "/#attribute[1]";
set "/#attribute/attr2" "foo" = attr2
let empty1 = "<a/>"
let empty2 = "<a foo=\"bar\"/>"
let empty3 = "<a foo=\"bar\"></a>\n"
let empty4 = "<a foo=\"bar\" far=\"baz\"/>"
test Xml.empty_element get empty1 = { "a" = "#empty" }
test Xml.empty_element get empty2 =
{ "a" = "#empty" { "#attribute" { "foo" = "bar"} } }
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar" = empty2
(* 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 put "<a><b/></a>" after clear "/a/b" = "<a><b></b>\n</a>"
test Xml.lns put "<a></a >" after set "/a/#text[1]" "foo";
set "/a/#text[2]" "bar" = "<a>foobar</a >"
test Xml.lns get "<?xml version=\"1.0\"?>
<!DOCTYPE catalog PUBLIC \"-//OASIS//DTD XML Catalogs V1.0//EN\"
\"file:///usr/share/xml/schema/xml-core/catalog.dtd\">
<doc/>" =
{ "#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 get "<oor:component-data
xmlns:oor=\"http://openoffice.org/2001/registry\"/>
" =
{ "oor:component-data" = "#empty"
{ "#attribute"
{ "xmlns:oor" = "http://openoffice.org/2001/registry"; }
}
}
let input1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<html>
<head>
<title>Wiki</title>
</head>
<body>
<h1>Augeas</h1>
<p class=\"main\">Augeas is now able to parse XML files!</p>
<ul>
<li>Translate from XML to a tree syntax</li>
<li>Translate from the tree back to XML</li> <!-- this is some
comment -->
<li>this</li>
</ul>
</body>
</html>
"
test Xml.doc get input1 =
{ "#declaration"
{ "#attribute"
{ "version" = "1.0" }
{ "encoding" = "UTF-8" }
}
}
{ "html"
{ "#text" = "\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 put input1 after rm "/html/body" =
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<html>
<head>
<title>Wiki</title>
</head>
</html>
"
let ul1 = "
<ul>
<li>test1</li>
<li>test2</li>
<li>test3</li>
<li>test4</li>
</ul>
"
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" = "
<ul>
<li>test1</li>
<li>test2</li>
<li>bidon</li>
<li>test4</li>
</ul>
"
test Xml.doc put ul1 after rm "/ul/li[2]" = "
<ul>
<li>test1</li>
<li>test3</li>
<li>test4</li>
</ul>
"
(* #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]" = "
<ul>
<li>test1</li>
<a></a>
<li>test2</li>
<li>test3</li>
<li>test4</li>
</ul>
"
test Xml.doc put ul1 after insa "a" "/ul/li[1]" = "
<ul>
<li>test1</li>
<a></a>
<li>test2</li>
<li>test3</li>
<li>test4</li>
</ul>
"
(* 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" = "
<ul>
<li>test1</li>
<li bidon=\"gazou\" foo=\"bar\">test2</li>
<li>test3</li>
<li>test4</li>
</ul>
"
(* if empty element is allowed to be as root, this test triggers error *)
test Xml.lns get "<doc>
<a><c/><b><c/></b><c/><c/><a></a></a>
</doc>" =
{ "doc"
{ "#text" = "\n" }
{ "a"
{ "c" = "#empty" }
{ "b"
{ "c" = "#empty" }
}
{ "c" = "#empty" }
{ "c" = "#empty" }
{ "a" }
}
}
let p01pass2 = "<?PI before document element?>
<!-- comment after document element-->
<?PI before document element?>
<!-- comment after document element-->
<?PI before document element?>
<!-- comment after document element-->
<?PI before document element?>
<!DOCTYPE doc
[
<!ELEMENT doc ANY>
<!ELEMENT a ANY>
<!ELEMENT b ANY>
<!ELEMENT c ANY>
]>
<doc>
<a><b><c/></b></a>
</doc>
<!-- comment after document element-->
<?PI after document element?>
<!-- comment after document element-->
<?PI after document element?>
<!-- comment after document element-->
<?PI after document element?>
"
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
"<doc>\n<A:._-0/>\n<::._-0/>\n<_:._-0/>\n<A/>\n<_/>\n<:/>\n</doc>" =
{ "doc"
{ "#text" = "\n" }
{ "A:._-0" = "#empty" }
{ "::._-0" = "#empty" }
{ "_:._-0" = "#empty" }
{ "A" = "#empty" }
{ "_" = "#empty" }
{ ":" = "#empty" }
}
test Xml.lns get "<doc>
<abcdefghijklmnopqrstuvwxyz/>
<ABCDEFGHIJKLMNOPQRSTUVWXYZ/>
<A01234567890/>
<A.-:/>
</doc>" =
{ "doc"
{ "#text" = "\n" }
{ "abcdefghijklmnopqrstuvwxyz" = "#empty" }
{ "ABCDEFGHIJKLMNOPQRSTUVWXYZ" = "#empty" }
{ "A01234567890" = "#empty" }
{ "A.-:" = "#empty" }
}
let p06fail1 = "<!--non-validating processors may pass this instance because
they don't check the IDREFS attribute type-->
<!DOCTYPE doc
[
<!ELEMENT doc (a|refs)*>
<!ELEMENT a EMPTY>
<!ELEMENT refs EMPTY>
<!ATTLIST refs refs IDREFS #REQUIRED>
<!ATTLIST a id ID #REQUIRED>
]>
<doc>
<a id=\"A1\"/><a id=\"A2\"/><a id=\"A3\"/>
<refs refs=\"\"/>
</doc>"
(* 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"
{
{ "#name" = "refs" }
{ "#type" = "IDREFS" }
{ "#REQUIRED" }
}
}
{ "!ATTLIST" = "a"
{
{ "#name" = "id" }
{ "#type" = "ID" }
{ "#REQUIRED" }
}
}
}
{ "doc"
{ "#text" = "\n" }
{ "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 = "<doc><A a=\"asdf>'">\nasdf\n ?>%\"/></doc>"
let p10pass1_2 = "<doc><A a='\"\">'"'/></doc>"
test Xml.lns get p10pass1_1 =
{ "doc"
{ "A" = "#empty"
{ "#attribute"
{ "a" = "asdf>'">\nasdf\n ?>%" }
}
}
}
test Xml.lns get p10pass1_2 = *
(* here again, test exclude single quote *)
let p11pass1 = "<!--Inability to resolve a notation should not be reported as
an error-->
<!DOCTYPE doc
[
<!ELEMENT doc EMPTY>
<!NOTATION not1 SYSTEM \"a%a&b�<!ELEMENT<!--<?</>?>/\''\">
<!NOTATION not3 SYSTEM \"\">
]>
<doc></doc>"
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"
{ "#literal" = "a%a&b�<!ELEMENT<!--<?</>?>/\''" }
}
}
{ "!NOTATION" = "not3"
{ "SYSTEM"
{ "#literal" = "" }
}
}
}
{ "doc" }
test Xml.lns get "<doc>a%b%</doc></doc>]]<&</doc>" =
{ "doc"
{ "#text" = "a%b%</doc></doc>]]<&" }
}
let p15pass1 = "<!--a
<!DOCTYPE
<?-
]]>-<[ CDATA [
\"- -'-
-<doc>-->
<!---->
<doc></doc>"
test Xml.lns get p15pass1 =
{ "#comment" = "a
<!DOCTYPE
<?-
]]>-<[ CDATA [
\"- -'-
-<doc>" }
{ "#comment" = "" }
{ "doc" }
let p22pass3 = "<?xml version=\"1.0\"?>
<!--comment--> <?pi some instruction ?>
<doc><?pi?></doc>"
test Xml.lns get p22pass3 =
{ "#declaration"
{ "#attribute"
{ "version" = "1.0" }
}
}
{ "#comment" = "comment" }
{ "#pi"
{ "#target" = "pi" }
{ "#instruction" = "some instruction " }
}
{ "doc"
{ "#pi"
{ "#target" = "pi" }
}
}
let p25pass2 = "<?xml version
=
\"1.0\"?>
<doc></doc>"
test Xml.lns get p25pass2 =
{ "#declaration"
{ "#attribute"
{ "version" = "1.0" }
}
}
{ "doc" }
test Xml.lns get "<!DOCTYPE
doc
[
<!ELEMENT doc EMPTY>
]>
<doc></doc>" =
{ "!DOCTYPE" = "doc"
{ "!ELEMENT" = "doc"
{ "#decl" = "EMPTY" }
}
}
{ "doc" }
test Xml.lns get "<doc></doc \n>" = { "doc" }
test Xml.lns get "<a><doc att=\"val\" \natt2=\"val2\" att3=\"val3\"/></a>" =
{ "a"
{ "doc" = "#empty"
{ "#attribute"
{ "att" = "val" }
{ "att2" = "val2" }
{ "att3" = "val3" }
}
}
}
test Xml.lns get "<doc/>" = { "doc" = "#empty" }
(* failure tests *)
(* only one document element *)
test Xml.lns get "<doc></doc><bad/>" = *
(* document element must be complete *)
test Xml.lns get "<doc>" = *
(* emtpy document is rejected *)
test Xml.lns get "" = *
(* malformed element *)
test Xml.lns get "<a><A@/></a>" = *
(* a Name cannot start with a digit *)
test Xml.lns get "<a><0A/></a>" = *
(* no space before "CDATA" *)
test Xml.lns get "<doc><![ CDATA[a]]></doc>" = *
(* no space after "CDATA" *)
test Xml.lns get "<doc><![CDATA [a]]></doc>" = *
(* CDSect's can't nest *)
test Xml.lns get "<doc>
<![CDATA[
<![CDATA[XML doesn't allow CDATA sections to nest]]>
]]>
</doc>" = *
(* Comment is illegal in VersionInfo *)
test Xml.lns get "<?xml version <!--bad comment--> =\"1.0\"?>
<doc></doc>" = *
(* only declarations in DTD *)
test Xml.lns get "<!DOCTYPE doc [
<!ELEMENT doc EMPTY>
<doc></doc>
]>" = *
(* we do not support external entities *)
test Xml.lns get "<!DOCTYPE doc [
<!ENTITY % eldecl \"<!ELEMENT doc EMPTY>\">
%eldecl;
]>
<doc></doc>" = *
(* XML lens for Augeas
Author: Francis Giraldeau <[email protected]>
Reference: http://www.w3.org/TR/2006/REC-xml11-20060816/
*)
module Xml =
autoload xfm
(************************************************************************
* Utilities lens
*************************************************************************)
let dels (s:string) = del s s
let spc = /[ \t\n]+/
let osp = /[ \t\n]*/
let sep_spc = del /[ \t\n]+/ " "
let sep_osp = del /[ \t\n]*/ ""
let sep_eq = del /[ \t\n]*=[ \t\n]*/ "="
let nmtoken = /[a-zA-Z:_][a-zA-Z0-9:_\.-]*/
let word = /[a-zA-Z][a-zA-Z0-9\._\-]*/
let char = /.|\n/
(* if we hide the quotes, then we can only accept single or double quotes *)
(* otherwise a put ambiguity is raised *)
let sto_dquote = dels "\"" . store /[^"]*/ . dels "\""
let sto_squote = dels "'" . store /[^']*/ . dels "'"
let comment = [ label "#comment" . dels "<!--" . store
/([^-]|-[^-])*/ . dels "-->" ]
let pi_target = nmtoken - /[Xx][Mm][Ll]/
let empty = Util.empty
let del_end = del />[\n]?/ ">\n"
(************************************************************************
* Attributes
*************************************************************************)
let decl = [ label "#decl" . sep_spc . store /[^> \t\n\r]|[^>
\t\n\r][^>\t\n\r]*[^> \t\n\r]/ ]
let decl_def (r:regexp) (b:lens) = [ dels "<" . key r .
sep_spc . store word . b . sep_osp .
del_end ]
let elem_def = decl_def /!ELEMENT/ decl
let enum = "(" . osp . nmtoken . ( osp . "|" . osp . nmtoken )* . osp
. ")"
let att_type = /CDATA|ID|IDREF|IDREFS|ENTITY|ENTITIES|NMTOKEN|NMTOKENS/ |
enum
let id_def = [ sep_spc . key /SYSTEM|PUBLIC/ . [ label "#literal" .
sep_spc . sto_dquote ]* ]
let notation_def = decl_def /!NOTATION/ id_def
let att_def = [ sep_spc . [ label "#name" . store word . sep_spc ] .
[ label "#type" . store att_type . sep_spc ] .
([ key /#REQUIRED|#IMPLIED/ ] |
[ label "#FIXED" . (dels "#FIXED" . sep_spc)?
. sto_dquote ]) ]
let att_list_def = decl_def /!ATTLIST/ att_def*
let entity_def = decl_def /!ENTITY/ ([sep_spc . label "#decl" . sto_dquote ])
let decl_def_item = elem_def | entity_def | att_list_def | notation_def
let decl_outer = sep_osp . del /\[[ \n\t\r]*/ "[\n" . decl_def_item* . dels
"]"
let dtd_def = [ sep_spc . key "SYSTEM" . sep_spc . sto_dquote ]
let doctype = decl_def /!DOCTYPE/ (dtd_def|decl_outer|id_def)
let attributes = [ label "#attribute" .
[ sep_spc . key nmtoken . sep_eq . sto_dquote ]+ ]
let prolog = [ label "#declaration" .
dels "<?xml" .
attributes .
sep_osp .
dels "?>" ]
(************************************************************************
* Tags
*************************************************************************)
(* we consider entities as text *)
let text_re = /[^<]+/ - /([^<]*\]\]>[^<]*)/
let text = [ label "#text" . store text_re ]
let cdata = [ label "#CDATA" . dels "<![CDATA[" .
store (char* - (char* . "]]>" . char*)) . dels "]]>" ]
let element (body:lens) =
let h = attributes? . sep_osp . dels ">" . body* . dels "</" in
[ dels "<" . square nmtoken h . sep_osp . del_end ]
let empty_element = [ dels "<" . key nmtoken . value "#empty" . attributes? .
sep_osp . del /\/>[\n]?/ "/>\n" ]
let pi_instruction = [ dels "<?" . label "#pi" .
[ label "#target" . store pi_target ] .
[ sep_spc . label "#instruction" . store (char* - (char*
. "?>" . char*)) ]? .
sep_osp . del /\?>[\n]?/ "?>\n" ]
(* Typecheck is weaker on rec lens, detected by unfolding *)
(*
let content1 = element text
let rec content2 = element (content1|text|comment)
*)
let rec content = element (text|comment|content|empty_element|pi_instruction)
(* we don't allow root element to be empty (ex: <a/>) because it's known to *)
(* leads to ambiguity *)
(* let rec content = element
(text|comment|content|empty_element|pi_instruction) | empty_element *)
(* Constraints are weaker here, but it's better than being too strict *)
let doc = (sep_osp . (prolog | comment | doctype | pi_instruction))* .
((sep_osp . content) | (sep_osp . empty_element)) .
(sep_osp . (comment | pi_instruction ))* . sep_osp
let lns = doc
let filter = (incl "/etc/xml/*.xml")
. (incl "/etc/obex-data-server/*.xml")
. (incl "/etc/bonobo-activation/*.xml")
. (incl "/etc/gtkmathview/*.xml")
. Util.stdexcl
let xfm = transform lns filter>From e90f097871fe880a9af95601ed75ca3d0afc281c Mon Sep 17 00:00:00 2001
From: Francis Giraldeau <[email protected]>
Date: Wed, 6 Oct 2010 14:21:32 -0400
Subject: [PATCH] Add square lens to language
The new primitive square lens allows to handle XML like open and close tags.
It takes 2 arguments, a regexp for the tag and a lens for the content. The
square lens verify that open and close tags are matched in the get direction,
and put direction handles the close tag by copying the key.
* src/builtin.c: add "square" keyword to language
* src/lens.c: lns_make_square to compile the lens from actual simpler
lenses
* src/lens.h: append L_SQUARE to lens_tag enum to identify the square lens
type object
* src/jmt.c: handle square lens in parser
* src/get.c: add char* square to state struct to hold the last L_DEL in
square to perform syntax check, and add all get handling functions for
L_SQUARE
* src/put.c: modify create_del to render current key when default string is
NULL and add all put handling functions
* tests/modules/pass_square.aug: unit tests to validate the square lens,
regular and recursives
---
src/builtin.c | 11 ++++
src/get.c | 106 ++++++++++++++++++++++++++++++++++++--
src/jmt.c | 10 ++++
src/lens.c | 74 ++++++++++++++++++++++++++-
src/lens.h | 11 +++-
src/put.c | 27 +++++++++-
tests/modules/pass_square.aug | 114 +++++++++++++++++++++++++++++++++++++++++
7 files changed, 343 insertions(+), 10 deletions(-)
create mode 100644 tests/modules/pass_square.aug
diff --git a/src/builtin.c b/src/builtin.c
index 1c0aa81..1b339e3 100644
--- a/src/builtin.c
+++ b/src/builtin.c
@@ -86,6 +86,16 @@ static struct value *lns_counter(struct info *info, struct value *str) {
return lns_make_prim(L_COUNTER, ref(info), NULL, ref(str->string));
}
+/* V_REGEXP -> V_LENS -> V_LENS */
+static struct value *lns_square(struct info *info, struct value *rxp,
+ struct value *lns) {
+ assert(rxp->tag == V_REGEXP);
+ assert(lns->tag == V_LENS);
+ int check = info->error->aug->flags & AUG_TYPE_CHECK;
+
+ return lns_make_square(ref(info), ref(rxp->regexp), ref(lns->lens), check);
+}
+
static struct value *make_exn_lns_error(struct info *info,
struct lns_error *err,
const char *text) {
@@ -541,6 +551,7 @@ struct module *builtin_init(struct error *error) {
DEFINE_NATIVE(modl, "label", 1, lns_label, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "seq", 1, lns_seq, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "counter", 1, lns_counter, T_STRING, T_LENS);
+ DEFINE_NATIVE(modl, "square", 2, lns_square, T_REGEXP, T_LENS, T_LENS);
/* Applying lenses (mostly for tests) */
DEFINE_NATIVE(modl, "get", 2, lens_get, T_LENS, T_STRING, T_TREE);
DEFINE_NATIVE(modl, "put", 3, lens_put, T_LENS, T_TREE, T_STRING,
diff --git a/src/get.c b/src/get.c
index 11ea5de..dbab6fa 100644
--- a/src/get.c
+++ b/src/get.c
@@ -49,6 +49,7 @@ struct state {
struct seq *seqs;
char *key;
char *value; /* GET_STORE leaves a value here */
+ char *square; /* last L_DEL from L_SQUARE */
struct lns_error *error;
/* We use the registers from a regular expression match to keep track
* of the substring we are currently looking at. REGS are the registers
@@ -71,12 +72,13 @@ struct state {
struct frame {
struct lens *lens;
char *key;
+ char *square;
union {
- struct {
+ struct { /* MGET */
char *value;
struct tree *tree;
};
- struct {
+ struct { /* M_PARSE */
struct skel *skel;
struct dict *dict;
};
@@ -156,7 +158,7 @@ static struct skel *make_skel(struct lens *lens) {
void free_skel(struct skel *skel) {
if (skel == NULL)
return;
- if (skel->tag == L_CONCAT || skel->tag == L_STAR || skel->tag == L_MAYBE) {
+ if (skel->tag == L_CONCAT || skel->tag == L_STAR || skel->tag == L_MAYBE || skel->tag == L_SQUARE) {
while (skel->skels != NULL) {
struct skel *del = skel->skels;
skel->skels = del->next;
@@ -383,6 +385,9 @@ static struct tree *get_del(struct lens *lens, struct state *state) {
get_error(state, lens, "no match for del /%s/", pat);
free(pat);
}
+ if (lens->string == NULL) {
+ state->square = token(state);
+ }
return NULL;
}
@@ -682,6 +687,41 @@ static struct skel *parse_subtree(struct lens *lens, struct state *state,
return make_skel(lens);
}
+static struct tree *get_square(struct lens *lens, struct state *state) {
+ ensure0(lens->tag == L_SQUARE, state->info);
+
+ struct tree *tree = NULL;
+ char *key = NULL, *square = NULL;
+
+ // get the child lens
+ tree = get_concat(lens->child, state);
+
+ key = state->key;
+ square = state->square;
+ ensure0(key != NULL, state->info);
+ ensure0(square != NULL, state->info);
+
+ if (strcmp(key, square) != 0) {
+ get_error(state, lens, "%s \"%s\" %s \"%s\"",
+ "Parse error: mismatched key in square lens, expecting", key,
+ "but got", square);
+ }
+
+ FREE(state->square);
+ return tree;
+}
+
+static struct skel *parse_square(struct lens *lens, struct state *state, struct dict **dict) {
+ ensure0(lens->tag == L_SQUARE, state->info);
+ struct skel *skel, *sk;
+
+ skel = parse_concat(lens->child, state, dict);
+ sk = make_skel(lens);
+ sk->skels = skel;
+
+ return sk;
+}
+
/*
* Helpers for recursive lenses
*/
@@ -691,7 +731,7 @@ static void print_frames(struct rec_state *state) {
for (int j = state->fused - 1; j >=0; j--) {
struct frame *f = state->frames + j;
for (int i=0; i < state->lvl; i++) fputc(' ', stderr);
- fprintf(stderr, "%2d %s %s", j, f->key, f->value);
+ fprintf(stderr, "%2d %s %s %s", j, f->key, f->value, f->square);
if (f->tree == NULL) {
fprintf(stderr, " - ");
} else {
@@ -760,8 +800,10 @@ static void get_terminal(struct frame *top, struct lens *lens,
top->tree = get_lens(lens, state);
top->key = state->key;
top->value = state->value;
+ top->square = state->square;
state->key = NULL;
state->value = NULL;
+ state->square = NULL;
}
static void parse_terminal(struct frame *top, struct lens *lens,
@@ -821,7 +863,7 @@ static void visit_enter(struct lens *lens,
static void get_combine(struct rec_state *rec_state,
struct lens *lens, uint n) {
struct tree *tree = NULL, *tail = NULL;
- char *key = NULL, *value = NULL;
+ char *key = NULL, *value = NULL, *square = NULL;
struct frame *top = NULL;
if (n > 0)
@@ -841,11 +883,16 @@ static void get_combine(struct rec_state *rec_state,
ensure(value == NULL, rec_state->state->info);
value = top->value;
}
+ if (top->square != NULL) {
+ ensure(square == NULL, rec_state->state->info);
+ square = top->square;
+ }
}
top = push_frame(rec_state, lens);
top->tree = tree;
top->key = key;
top->value = value;
+ top->square = square;
error:
return;
}
@@ -899,6 +946,7 @@ static void visit_exit(struct lens *lens,
struct frame *top = top_frame(rec_state);
if (rec_state->mode == M_GET) {
struct tree *tree;
+ // FIXME: tree may leak if pop_frame ensure0 fail
tree = make_tree(top->key, top->value, NULL, top->tree);
ERR_NOMEM(tree == NULL, lens->info);
top = pop_frame(rec_state);
@@ -957,6 +1005,29 @@ static void visit_exit(struct lens *lens,
get_combine(rec_state, lens, n);
else
parse_combine(rec_state, lens, n);
+ } else if (lens->tag == L_SQUARE) {
+ if (rec_state->mode == M_GET) {
+ char *key, *square;
+
+ key = top_frame(rec_state)->key;
+ square = top_frame(rec_state)->square;
+
+ ensure(key != NULL, state->info);
+ ensure(square != NULL, state->info);
+
+ // raise syntax error if they are not equals
+ if (strcmp(key, square) != 0){
+ get_error(state, lens, "%s \"%s\" %s \"%s\"",
+ "Parse error: mismatched key in square lens, expecting", key,
+ "but got", square);
+ state->error->pos = end - strlen(square);
+ goto error;
+ }
+
+ get_combine(rec_state, lens, 1);
+ } else {
+ parse_combine(rec_state, lens, 1);
+ }
} else {
top_frame(rec_state)->lens = lens;
}
@@ -985,6 +1056,8 @@ static struct frame *rec_process(enum mode_t mode, struct lens *lens,
int r;
struct jmt_visitor visitor;
struct rec_state rec_state;
+ int i;
+ struct frame *f = NULL;
MEMZERO(&rec_state, 1);
MEMZERO(&visitor, 1);
@@ -1032,6 +1105,19 @@ static struct frame *rec_process(enum mode_t mode, struct lens *lens,
jmt_free_parse(visitor.parse);
return rec_state.frames;
error:
+
+ for(i = 0; i < rec_state.fused; i++) {
+ f = nth_frame(&rec_state, i);
+ FREE(f->key);
+ FREE(f->square);
+ if (mode == M_GET) {
+ FREE(f->value);
+ free_tree(f->tree);
+ } else if (mode == M_PARSE) {
+ free_skel(f->skel);
+ free_dict(f->dict);
+ }
+ }
FREE(rec_state.frames);
goto done;
}
@@ -1105,6 +1191,9 @@ static struct tree *get_lens(struct lens *lens, struct state *state) {
case L_MAYBE:
tree = get_quant_maybe(lens, state);
break;
+ case L_SQUARE:
+ tree = get_square(lens, state);
+ break;
default:
BUG_ON(true, state->info, "illegal lens tag %d", lens->tag);
break;
@@ -1180,6 +1269,10 @@ struct tree *lns_get(struct info *info, struct lens *lens, const char *text,
get_error(&state, lens, "get left unused value %s", state.value);
free(state.value);
}
+ if (state.square != NULL) {
+ get_error(&state, lens, "get left unused square %s", state.square);
+ free(state.square);
+ }
if (partial && state.error == NULL) {
get_error(&state, lens, "Get did not match entire input");
}
@@ -1241,6 +1334,9 @@ static struct skel *parse_lens(struct lens *lens, struct state *state,
case L_MAYBE:
skel = parse_quant_maybe(lens, state, dict);
break;
+ case L_SQUARE:
+ skel = parse_square(lens, state, dict);
+ break;
default:
BUG_ON(true, state->info, "illegal lens tag %d", lens->tag);
break;
diff --git a/src/jmt.c b/src/jmt.c
index f7e5b48..3a52755 100644
--- a/src/jmt.c
+++ b/src/jmt.c
@@ -754,6 +754,7 @@ build_nullable(struct jmt_parse *parse, ind_t pos,
lens->children[i], lvl+1);
break;
case L_SUBTREE:
+ case L_SQUARE:
build_nullable(parse, pos, visitor, lens->child, lvl+1);
break;
case L_STAR:
@@ -1230,6 +1231,11 @@ static void print_grammar(struct jmt *jmt, struct lens *lens) {
printf("\n");
print_grammar(jmt, lens->body);
break;
+ case L_SQUARE:
+ print_lens_symbol(stdout, jmt, lens->child);
+ printf("\n");
+ print_grammar(jmt, lens->child);
+ break;
default:
BUG_ON(true, jmt, "Unexpected lens tag %d", lens->tag);
break;
@@ -1271,6 +1277,7 @@ static void index_lenses(struct jmt *jmt, struct lens *lens) {
case L_SUBTREE:
case L_STAR:
case L_MAYBE:
+ case L_SQUARE:
index_lenses(jmt, lens->child);
break;
case L_REC:
@@ -1472,6 +1479,9 @@ static void conv_rhs(struct jmt *jmt, ind_t l) {
conv(jmt, lens->child, &s, &e, &f);
add_new_trans(jmt, s, e, EPS);
break;
+ case L_SQUARE:
+ conv(jmt, lens->child, &s, &e, &f);
+ break;
default:
BUG_ON(true, jmt, "Unexpected lens tag %d", lens->tag);
}
diff --git a/src/lens.c b/src/lens.c
index 8500d00..86d3ec8 100644
--- a/src/lens.c
+++ b/src/lens.c
@@ -54,10 +54,11 @@ static struct value *typecheck_iter(struct info *info, struct lens *l);
static struct value *typecheck_maybe(struct info *info, struct lens *l);
/* Lens names for pretty printing */
+/* keep order in sync with enum type */
static const char *const tags[] = {
"del", "store", "value", "key", "label", "seq", "counter",
"concat", "union",
- "subtree", "star", "maybe", "rec"
+ "subtree", "star", "maybe", "rec", "square"
};
#define ltag(lens) (tags[lens->tag - L_DEL])
@@ -397,6 +398,65 @@ struct value *lns_make_maybe(struct info *info, struct lens *l, int check) {
return make_lens_value(lens);
}
+/* Build a square lens as
+ * key REG . lns . del REG MATCHED
+ * where MATCHED is whatever the key lens matched (the inability to express
+ * this with other lenses makes the square primitve necessary
+ */
+struct value *lns_make_square(struct info *info,
+ struct regexp *reg,
+ struct lens *lns, int check) {
+ struct value *key = NULL, *del = NULL;
+ struct value *cnt1 = NULL, *cnt2 = NULL, *res = NULL;
+ struct lens *sqr = NULL;
+
+ res = lns_make_prim(L_KEY, ref(info), ref(reg), NULL);
+ if (EXN(res))
+ goto error;
+ key = res;
+
+ res = lns_make_prim(L_DEL, ref(info), ref(reg), NULL);
+ if (EXN(res))
+ goto error;
+ del = res;
+
+ // typechecking is handled when concatenating lenses
+ res = lns_make_concat(ref(info), ref(key->lens), ref(lns), check);
+ if (EXN(res))
+ goto error;
+ cnt1 = res;
+
+ res = lns_make_concat(ref(info), ref(cnt1->lens), ref(del->lens), check);
+ if (EXN(res))
+ goto error;
+ cnt2 = res;
+
+ sqr = make_lens_unop(L_SQUARE, ref(info), ref(cnt2->lens));
+ ERR_NOMEM(sqr == NULL, info);
+
+ for (int t=0; t < ntypes; t++)
+ ltype(sqr, t) = ref(ltype(cnt2->lens, t));
+ sqr->recursive = cnt2->lens->recursive;
+ sqr->rec_internal = cnt2->lens->rec_internal;
+ sqr->consumes_value = cnt2->lens->consumes_value;
+
+ res = make_lens_value(sqr);
+ ERR_NOMEM(res == NULL, info);
+ sqr = NULL;
+
+ error:
+ unref(info, info);
+ unref(reg, regexp);
+ unref(lns, lens);
+
+ unref(key, value);
+ unref(del, value);
+ unref(cnt1, value);
+ unref(cnt2, value);
+ unref(sqr, lens);
+ return res;
+}
+
/*
* Lens primitives
*/
@@ -477,7 +537,7 @@ struct value *lns_make_prim(enum lens_tag tag, struct info *info,
string->str);
goto error;
}
- } else if (tag == L_DEL) {
+ } else if (tag == L_DEL && string != NULL) {
int cnt;
const char *dflt = string->str;
cnt = regexp_match(regexp, dflt, strlen(dflt), 0, NULL);
@@ -817,6 +877,7 @@ void free_lens(struct lens *lens) {
case L_SUBTREE:
case L_STAR:
case L_MAYBE:
+ case L_SQUARE:
unref(lens->child, lens);
break;
case L_CONCAT:
@@ -1121,6 +1182,9 @@ int lns_format_atype(struct lens *l, char **buf) {
case L_REC:
return lns_format_rec_atype(l, buf);
break;
+ case L_SQUARE:
+ return lns_format_concat_atype(l->child, buf);
+ break;
default:
BUG_LENS_TAG(l);
break;
@@ -1807,6 +1871,10 @@ static void propagate_type(struct lens *l, enum lens_type lt) {
case L_REC:
/* Nothing to do */
break;
+ case L_SQUARE:
+ propagate_type(l->child, lt);
+ ltype(l, lt) = ref(ltype(l->child, lt));
+ break;
default:
BUG_LENS_TAG(l);
break;
@@ -1883,6 +1951,7 @@ static struct value *typecheck(struct lens *l, int check) {
exn = typecheck_n(l, lns_make_union, check);
break;
case L_SUBTREE:
+ case L_SQUARE:
exn = typecheck(l->child, check);
break;
case L_STAR:
@@ -1997,6 +2066,7 @@ static int ctype_nullable(struct lens *lens, struct value **exn) {
}
break;
case L_SUBTREE:
+ case L_SQUARE:
ret = ctype_nullable(lens->child, exn);
nullable = lens->child->ctype_nullable;
break;
diff --git a/src/lens.h b/src/lens.h
index 28df3fa..fee80d2 100644
--- a/src/lens.h
+++ b/src/lens.h
@@ -27,6 +27,7 @@
#include "fa.h"
#include "jmt.h"
+/* keep in sync with tag name table */
enum lens_tag {
L_DEL = 42, /* Shift tag values so we fail fast(er) on bad pointers */
L_STORE,
@@ -40,7 +41,8 @@ enum lens_tag {
L_SUBTREE,
L_STAR,
L_MAYBE,
- L_REC
+ L_REC,
+ L_SQUARE
};
/* A lens. The way the type information is computed is a little
@@ -88,11 +90,14 @@ struct lens {
union {
/* Primitive lenses */
struct { /* L_DEL uses both */
+ /* L_DEL string set to NULL means it belongs to parent L_SQUARE lens
+ * and the put and create copy the current key
+ */
struct regexp *regexp; /* L_STORE, L_KEY */
struct string *string; /* L_VALUE, L_LABEL, L_SEQ, L_COUNTER */
};
/* Combinators */
- struct lens *child; /* L_SUBTREE, L_STAR, L_MAYBE */
+ struct lens *child; /* L_SUBTREE, L_STAR, L_MAYBE, L_SQUARE */
struct { /* L_UNION, L_CONCAT */
unsigned int nchildren;
struct lens **children;
@@ -139,6 +144,8 @@ struct value *lns_make_plus(struct info *, struct lens *,
int check);
struct value *lns_make_maybe(struct info *, struct lens *,
int check);
+struct value *lns_make_square(struct info *, struct regexp *, struct lens *,
+ int check);
/* Pretty-print a lens */
char *format_lens(struct lens *l);
diff --git a/src/put.c b/src/put.c
index d592420..32618c4 100644
--- a/src/put.c
+++ b/src/put.c
@@ -419,6 +419,8 @@ static int skel_instance_of(struct lens *lens, struct skel *skel) {
return 1;
case L_REC:
return skel_instance_of(lens->body, skel);
+ case L_SQUARE:
+ return skel->tag == L_SQUARE;
default:
BUG_ON(true, lens->info, "illegal lens tag %d", lens->tag);
break;
@@ -466,7 +468,12 @@ static void put_del(ATTRIBUTE_UNUSED struct lens *lens, struct state *state) {
assert(lens->tag == L_DEL);
assert(state->skel != NULL);
assert(state->skel->tag == L_DEL);
+ if (lens->string != NULL) {
fprintf(state->out, "%s", state->skel->text);
+ } else {
+ /* L_DEL with NULL string: replicate the current key */
+ fprintf(state->out, "%s", state->key);
+ }
}
static void put_union(struct lens *lens, struct state *state) {
@@ -590,6 +597,13 @@ static void put_rec(struct lens *lens, struct state *state) {
put_lens(lens->body, state);
}
+static void put_square(struct lens *lens, struct state *state) {
+ struct skel *oldskel = state->skel;
+ state->skel = state->skel->skels;
+ put_lens(lens->child, state);
+ state->skel = oldskel;
+}
+
static void put_lens(struct lens *lens, struct state *state) {
if (state->error != NULL)
return;
@@ -632,6 +646,9 @@ static void put_lens(struct lens *lens, struct state *state) {
case L_REC:
put_rec(lens, state);
break;
+ case L_SQUARE:
+ put_square(lens, state);
+ break;
default:
assert(0);
break;
@@ -644,8 +661,13 @@ static void create_subtree(struct lens *lens, struct state *state) {
static void create_del(struct lens *lens, struct state *state) {
assert(lens->tag == L_DEL);
-
+ if (lens->string != NULL) {
print_escaped_chars(state->out, lens->string->str);
+ } else {
+ /* L_DEL with NULL string: replicate the current key */
+ print_escaped_chars(state->out, state->key);
+ }
+
}
static void create_union(struct lens *lens, struct state *state) {
@@ -754,6 +776,9 @@ static void create_lens(struct lens *lens, struct state *state) {
case L_REC:
create_rec(lens, state);
break;
+ case L_SQUARE:
+ create_concat(lens->child, state);
+ break;
default:
assert(0);
break;
diff --git a/tests/modules/pass_square.aug b/tests/modules/pass_square.aug
new file mode 100644
index 0000000..7d9b2dd
--- /dev/null
+++ b/tests/modules/pass_square.aug
@@ -0,0 +1,114 @@
+module Pass_square =
+
+(* Utilities lens *)
+let dels (s:string) = del s s
+
+(************************************************************************
+ * Regular square lens
+ *************************************************************************)
+
+(* Simplest square lens *)
+let s = store /[yz]/
+let sqr0 = [ square "x" s ] *
+test sqr0 get "xyxxyxxyx" = { "x" = "y" }{ "x" = "y" }{ "x" = "y" }
+test sqr0 put "xyx" after set "/x[3]" "z" = "xyxxzx"
+
+(* test mismatch tag *)
+test sqr0 get "xya" = *
+
+(* Test regular expression matching with multiple groups *)
+let body = del /([f]+)([f]+)/ "ff" . del /([g]+)([g]+)/ "gg"
+let sqr1 = [ square /([a-b]*)([a-b]*)([a-b]*)/ body . del /([x]+)([x]+)/ "xx" ] *
+
+test sqr1 get "aaffggaaxxbbffggbbxx" = { "aa" }{ "bb" }
+test sqr1 get "affggaxx" = { "a" }
+test sqr1 put "affggaxx" after clear "/b" = "affggaxxbffggbxx"
+
+(* Test XML like elements up to depth 2 *)
+let b = del ">" ">" . del /[a-z ]*/ "" . del "</" "</"
+let xml = [ del "<" "<" . square /[a-z]+/ b . del ">" ">" ] *
+
+let b2 = del ">" ">" . xml . del "</" "</"
+let xml2 = [ del "<" "<" . square /[a-z]+/ b2 . del ">" ">" ] *
+
+test xml get "<a></a><b></b>" = { "a" }{ "b" }
+
+(* test error on mismatch tag *)
+test xml get "<a></a><b></c>" = *
+
+(* test get nested tags of depth 2 *)
+test xml2 get "<a><b></b><c></c></a>" =
+ { "a"
+ { "b" }
+ { "c" }
+ }
+
+(* test nested put of depth 2 *)
+test xml2 put "<a></a>" after clear "/x/y" = "<a></a><x><y></y></x>"
+
+(* test nested put of depth 3 : should fail *)
+test xml2 put "<a></a>" after clear "/x/y/z" = *
+
+(************************************************************************
+ * Recursive square lens
+ *************************************************************************)
+
+(* Basic element *)
+let xml_element (body:lens) =
+ let g = del ">" ">" . body . del "</" "</" in
+ [ del "<" "<" . square /[a-z]+/ g . del ">" ">" ] *
+
+let rec xml_rec = xml_element xml_rec
+
+test xml_rec get "<a><b><c><d><e></e></d></c></b></a>" =
+ { "a"
+ { "b"
+ { "c"
+ { "d"
+ { "e" }
+ }
+ }
+ }
+ }
+
+test xml_rec get "<a><b></b><c></c><d></d><e></e></a>" =
+ { "a"
+ { "b" }
+ { "c" }
+ { "d" }
+ { "e" }
+ }
+
+test xml_rec put "<a></a><b><c></c></b>" after clear "/x/y/z" = "<a></a><b><c></c></b><x><y><z></z></y></x>"
+
+(* mismatch tag *)
+test xml_rec get "<a></c>" = *
+test xml_rec get "<a><b></b></c>" = *
+test xml_rec get "<a><b></c></a>" = *
+
+(* test ctype_nullable and typecheck *)
+let rec z = [ square "ab" z? ]
+test z get "abab" = { "ab" }
+
+(* test tip handling when using store inside body *)
+let c (body:lens) =
+ let sto = store "c" . body* in
+ [ square "ab" sto ]
+
+let rec cc = c cc
+
+test cc get "abcabcabab" =
+ { "ab" = "c"
+ { "ab" = "c" }
+ }
+
+(* test correct put behavior *)
+let input3 = "aaxyxbbaaaxyxbb"
+let b3 = dels "y"
+let sqr3 = [ del /[a]*/ "a" . square /[x]/ b3 . del /[b]*/ "b" ]*
+test sqr3 get input3 = { "x" }{ "x" }
+test sqr3 put input3 after clear "/x[1]" = input3
+
+let b4 = del "x" "x"
+let rec sqr4 = [ del /[a]+/ "a" . square /[b]|[c]/ (b4|sqr4) ]
+test sqr4 put "aabaaacxcb" after rm "x" = "aabaaacxcb"
\ No newline at end of file
--
1.7.1
_______________________________________________
augeas-devel mailing list
[email protected]
https://www.redhat.com/mailman/listinfo/augeas-devel
