[augeas-devel] [PATCH 3/6] Add test cases for the new square lens
Francis Giraldeau
francis.giraldeau at gmail.com
Sun Aug 12 21:37:19 UTC 2012
Update square lens test to use lens arguments instead of regexp. The change
consists to replace "square re lens" into "square right lens left", where right
and left are lenses. Hence, legacy lens is converted this way:
Legacy:
let x = square re body
New definition:
let x =
let right = key re in
let left = del re "" in
square right body left
This patch splits pass_square.aug into regular and recursive tests. Other tests
are added to verify constraints on the square lens arguments and typechecking.
---
tests/modules/fail_square_consistency.aug | 6 ++
tests/modules/fail_square_consistency_del.aug | 6 ++
tests/modules/fail_square_dup_key.aug | 6 ++
tests/modules/fail_square_lens_type.aug | 6 ++
tests/modules/pass_square.aug | 111 +++++++-------------
tests/modules/pass_square_rec.aug | 139 +++++++++++++++++++++++++
6 files changed, 202 insertions(+), 72 deletions(-)
create mode 100644 tests/modules/fail_square_consistency.aug
create mode 100644 tests/modules/fail_square_consistency_del.aug
create mode 100644 tests/modules/fail_square_dup_key.aug
create mode 100644 tests/modules/fail_square_lens_type.aug
create mode 100644 tests/modules/pass_square_rec.aug
diff --git a/tests/modules/fail_square_consistency.aug b/tests/modules/fail_square_consistency.aug
new file mode 100644
index 0000000..b1cc3db
--- /dev/null
+++ b/tests/modules/fail_square_consistency.aug
@@ -0,0 +1,6 @@
+module Fail_square_consistency =
+
+let left = key "a"
+let right = del "b" "b"
+let body = del "x" "x"
+let s = square left body right
diff --git a/tests/modules/fail_square_consistency_del.aug b/tests/modules/fail_square_consistency_del.aug
new file mode 100644
index 0000000..bff74e8
--- /dev/null
+++ b/tests/modules/fail_square_consistency_del.aug
@@ -0,0 +1,6 @@
+module Fail_square_consistency_del =
+
+let left = del /[ab]/ "a"
+let right = del /[ab]/ "b"
+let body = del "x" "x"
+let s = square left body right
diff --git a/tests/modules/fail_square_dup_key.aug b/tests/modules/fail_square_dup_key.aug
new file mode 100644
index 0000000..0e540da
--- /dev/null
+++ b/tests/modules/fail_square_dup_key.aug
@@ -0,0 +1,6 @@
+module Fail_square_dup_key =
+
+let left = key "a"
+let right = del "a" "a"
+let body = key "a"
+let s = square left body right
diff --git a/tests/modules/fail_square_lens_type.aug b/tests/modules/fail_square_lens_type.aug
new file mode 100644
index 0000000..f1099e3
--- /dev/null
+++ b/tests/modules/fail_square_lens_type.aug
@@ -0,0 +1,6 @@
+module Fail_square_lens_type =
+
+let left = [ key "a" ]
+let right = [ key "a" ]
+let body = del "x" "x"
+let s = square left body right
diff --git a/tests/modules/pass_square.aug b/tests/modules/pass_square.aug
index f41761d..fff56e9 100644
--- a/tests/modules/pass_square.aug
+++ b/tests/modules/pass_square.aug
@@ -8,17 +8,24 @@ let dels (s:string) = del s s
*************************************************************************)
(* 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"
+let s = store /[ab]/
+let sqr0 =
+ let k = key "x" in
+ let d = dels "x" in
+ [ square k s d ] *
+test sqr0 get "xaxxbxxax" = { "x" = "a" }{ "x" = "b" }{ "x" = "a" }
+test sqr0 put "xax" after set "/x[3]" "b" = "xaxxbx"
(* 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" ] *
+let sqr1 =
+ let k = key /([a-b]*)([a-b]*)([a-b]*)/ in
+ let d1 = del /([a-b]*)([a-b]*)([a-b]*)/ "a" in
+ let d2 = del /([x]+)([x]+)/ "xx" in
+ [ square k body d1 . d2 ] *
test sqr1 get "aaffggaaxxbbffggbbxx" = { "aa" }{ "bb" }
test sqr1 get "affggaxx" = { "a" }
@@ -26,10 +33,12 @@ 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 open_tag = key /[a-z]+/
+let close_tag = del /[a-z]+/ "a"
+let xml = [ del "<" "<" . square open_tag b close_tag . del ">" ">" ] *
let b2 = del ">" ">" . xml . del "</" "</"
-let xml2 = [ del "<" "<" . square /[a-z]+/ b2 . del ">" ">" ] *
+let xml2 = [ del "<" "<" . square open_tag b2 close_tag . del ">" ">" ] *
test xml get "<a></a><b></b>" = { "a" }{ "b" }
@@ -49,72 +58,30 @@ 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"
-
(* matches can be case-insensitive *)
let s5 = store /[yz]/
-let sqr5 = [ square /x/i s ] *
+let sqr5 =
+ let k = key /x/i in
+ let d = del /x/i "x" in
+ [ square k s5 d ] *
+test sqr5 get "xyX" = { "x" = "y" }
test sqr5 get "xyXXyxXyx" = { "x" = "y" }{ "X" = "y" }{ "X" = "y" }
test sqr5 put "xyX" after set "/x[3]" "z" = "xyxxzx"
+
+(* test concat multiple squares *)
+let rex = /[a-z]/
+let csqr =
+ let k = key rex in
+ let d = del rex "a" in
+ let e = dels "" in
+ [ square k e d . square d e d ] *
+
+test csqr get "aabbccdd" = { "a" } { "c" }
+test csqr put "aabb" after insa "z" "/a" = "aabbzzaa"
+
+(* test default square create values *)
+let create_square =
+ let d = dels "a" in
+ [ key "x" . square d d d ]*
+
+test create_square put "" after clear "/x" = "xaaa"
diff --git a/tests/modules/pass_square_rec.aug b/tests/modules/pass_square_rec.aug
new file mode 100644
index 0000000..42bff7b
--- /dev/null
+++ b/tests/modules/pass_square_rec.aug
@@ -0,0 +1,139 @@
+module Pass_square_rec =
+
+(* Utilities lens *)
+let dels (s:string) = del s s
+
+(************************************************************************
+ * Recursive square lens
+ *************************************************************************)
+(* test square with left and right as dels *)
+let lr (body:lens) =
+ let k = key "c" . body* in
+ let d = dels "ab" in
+ [ square d k d ]
+
+let rec lr2 = lr lr2
+
+test lr2 get "abcabcabab" =
+ { "c"
+ { "c" }
+ }
+
+let open_tag = key /[a-z]+/
+let close_tag = del /[a-z]+/ "a"
+
+(* Basic element *)
+let xml_element (body:lens) =
+ let g = del ">" ">" . body . del "</" "</" in
+ [ del "<" "<" . square open_tag g close_tag . 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 =
+ let k = key "ab" in
+ let d = dels "ab" in
+ [ square k z? d ]
+test z get "abab" = { "ab" }
+
+(* test tip handling when using store inside body *)
+let c (body:lens) =
+ let sto = store "c" . body* in
+ let d = dels "ab" in
+ let k = key "ab" in
+ [ square k sto d ]
+
+let rec cc = c cc
+
+test cc get "abcabcabab" =
+ { "ab" = "c"
+ { "ab" = "c" }
+ }
+
+(* test mixing regular and recursive lenses *)
+
+let reg1 =
+ let k = key "y" in
+ let d = dels "y" in
+ let e = dels "" in
+ [ square k e d ]
+
+let reg2 =
+ let k = key "y" in
+ let d = dels "y" in
+ [ square k reg1 d ]
+
+let rec rec2 =
+ let d1 = dels "x" in
+ let k1 = key "x" in
+ let body = reg2 | rec2 in
+ [ square k1 body d1 ]?
+
+test rec2 get "xyyyyx" =
+ { "x"
+ { "y"
+ { "y" }
+ }
+ }
+
+test rec2 put "" after clear "/x/y/y" = "xyyyyx"
+
+(* test correct put behavior *)
+let input3 = "aaxyxbbaaaxyxbb"
+let b3 = dels "y"
+let sqr3 =
+ let k = key /[x]/ in
+ let d = dels "x" in
+ [ del /[a]*/ "a" . square k b3 d . del /[b]*/ "b" ]*
+test sqr3 get input3 = { "x" }{ "x" }
+test sqr3 put input3 after clear "/x[1]" = input3
+
+let b4 = dels "x"
+let rec sqr4 =
+ let k = key /[b]|[c]/ in
+ let d = del /[b]|[c]/ "b" in
+ [ del /[a]+/ "a" . square k (b4|sqr4) d ]
+test sqr4 put "aabaaacxcb" after rm "x" = "aabaaacxcb"
+
+(* test concat multiple squares *)
+let rex = /[a-z]/
+let rec csqr =
+ let k = key rex in
+ let d = del rex "a" in
+ let e = dels "" in
+ [ square k e d . csqr* . square d e d ]
+
+test csqr get "aabbccdd" =
+ { "a"
+ { "b" }
+ }
+
+test csqr put "aabbccdd" after clear "/a" = "aabbccdd"
+test csqr put "aabb" after clear "/a/z" = "aazzaabb"
--
1.7.9.5
More information about the augeas-devel
mailing list