320 lines
8.1 KiB
Plaintext
320 lines
8.1 KiB
Plaintext
|
(*
|
||
|
|
Module: Test_Build
|
||
|
|
Provides unit tests and examples for the <Build> lens.
|
||
|
|
*)
|
||
|
|
|
||
|
|
module Test_Build =
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: GENERIC CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(* View: brackets
|
||
|
|
Test brackets *)
|
||
|
|
let brackets = [ Build.brackets Sep.lbracket Sep.rbracket (key Rx.word) ]
|
||
|
|
|
||
|
|
(* Test: brackets *)
|
||
|
|
test brackets get "(foo)" = { "foo" }
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: LIST CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(* View: list *)
|
||
|
|
let list = Build.list [ key Rx.word ] Sep.space
|
||
|
|
|
||
|
|
(* Test: list *)
|
||
|
|
test list get "foo bar baz" = { "foo" } { "bar" } { "baz" }
|
||
|
|
|
||
|
|
(* Test: list *)
|
||
|
|
test list get "foo" = *
|
||
|
|
|
||
|
|
(* View: opt_list *)
|
||
|
|
let opt_list = Build.opt_list [ key Rx.word ] Sep.space
|
||
|
|
|
||
|
|
(* Test: opt_list *)
|
||
|
|
test opt_list get "foo bar baz" = { "foo" } { "bar" } { "baz" }
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: LABEL OPERATIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(* View: xchg *)
|
||
|
|
let xchg = [ Build.xchg Rx.space " " "space" ]
|
||
|
|
|
||
|
|
(* Test: xchg *)
|
||
|
|
test xchg get " \t " = { "space" }
|
||
|
|
|
||
|
|
(* View: xchgs *)
|
||
|
|
let xchgs = [ Build.xchgs " " "space" ]
|
||
|
|
|
||
|
|
(* Test: xchgs *)
|
||
|
|
test xchgs get " " = { "space" }
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: SUBNODE CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(* View: key_value_line *)
|
||
|
|
let key_value_line = Build.key_value_line Rx.word Sep.equal (store Rx.word)
|
||
|
|
|
||
|
|
(* Test: key_value_line *)
|
||
|
|
test key_value_line get "foo=bar\n" = { "foo" = "bar" }
|
||
|
|
|
||
|
|
(* View: key_value_line_comment *)
|
||
|
|
let key_value_line_comment = Build.key_value_line_comment Rx.word
|
||
|
|
Sep.equal (store Rx.word) Util.comment
|
||
|
|
|
||
|
|
(* Test: key_value_line_comment *)
|
||
|
|
test key_value_line_comment get "foo=bar # comment\n" =
|
||
|
|
{ "foo" = "bar" { "#comment" = "comment" } }
|
||
|
|
|
||
|
|
(* View: key_value *)
|
||
|
|
let key_value = Build.key_value Rx.word Sep.equal (store Rx.word)
|
||
|
|
|
||
|
|
(* Test: key_value *)
|
||
|
|
test key_value get "foo=bar" = { "foo" = "bar" }
|
||
|
|
|
||
|
|
(* View: key_ws_value *)
|
||
|
|
let key_ws_value = Build.key_ws_value Rx.word
|
||
|
|
|
||
|
|
(* Test: key_ws_value *)
|
||
|
|
test key_ws_value get "foo bar\n" = { "foo" = "bar" }
|
||
|
|
|
||
|
|
(* View: flag *)
|
||
|
|
let flag = Build.flag Rx.word
|
||
|
|
|
||
|
|
(* Test: flag *)
|
||
|
|
test flag get "foo" = { "foo" }
|
||
|
|
|
||
|
|
(* View: flag_line *)
|
||
|
|
let flag_line = Build.flag_line Rx.word
|
||
|
|
|
||
|
|
(* Test: flag_line *)
|
||
|
|
test flag_line get "foo\n" = { "foo" }
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: BLOCK CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(* View: block_entry
|
||
|
|
The block entry used for testing *)
|
||
|
|
let block_entry = Build.key_value "test" Sep.equal (store Rx.word)
|
||
|
|
|
||
|
|
(* View: block
|
||
|
|
The block used for testing *)
|
||
|
|
let block = Build.block block_entry
|
||
|
|
|
||
|
|
(* Test: block
|
||
|
|
Simple test for <block> *)
|
||
|
|
test block get " {test=1}" =
|
||
|
|
{ "test" = "1" }
|
||
|
|
|
||
|
|
(* Test: block
|
||
|
|
Simple test for <block> with newlines *)
|
||
|
|
test block get " {\n test=1\n}" =
|
||
|
|
{ "test" = "1" }
|
||
|
|
|
||
|
|
(* Test: block
|
||
|
|
Simple test for <block> two indented entries *)
|
||
|
|
test block get " {\n test=1 \n test=2 \n}" =
|
||
|
|
{ "test" = "1" }
|
||
|
|
{ "test" = "2" }
|
||
|
|
|
||
|
|
(* Test: block
|
||
|
|
Test <block> with a comment *)
|
||
|
|
test block get " { # This is a comment\n}" =
|
||
|
|
{ "#comment" = "This is a comment" }
|
||
|
|
|
||
|
|
(* Test: block
|
||
|
|
Test <block> with comments and newlines *)
|
||
|
|
test block get " { # This is a comment\n# Another comment\n}" =
|
||
|
|
{ "#comment" = "This is a comment" }
|
||
|
|
{ "#comment" = "Another comment" }
|
||
|
|
|
||
|
|
(* Test: block
|
||
|
|
Test defaults for blocks *)
|
||
|
|
test block put " { test=1 }" after
|
||
|
|
set "/#comment" "a comment";
|
||
|
|
rm "/test";
|
||
|
|
set "/test" "2" =
|
||
|
|
" { # a comment\ntest=2 }"
|
||
|
|
|
||
|
|
(* View: named_block
|
||
|
|
The named block used for testing *)
|
||
|
|
let named_block = Build.named_block "foo" block_entry
|
||
|
|
|
||
|
|
(* Test: named_block
|
||
|
|
Simple test for <named_block> *)
|
||
|
|
test named_block get "foo {test=1}\n" =
|
||
|
|
{ "foo" { "test" = "1" } }
|
||
|
|
|
||
|
|
(* View: logrotate_block
|
||
|
|
A minimalistic logrotate block *)
|
||
|
|
let logrotate_block =
|
||
|
|
let entry = [ key Rx.word ]
|
||
|
|
in let filename = [ label "file" . store /\/[^,#= \n\t{}]+/ ]
|
||
|
|
in let filename_sep = del /[ \t\n]+/ " "
|
||
|
|
in let filenames = Build.opt_list filename filename_sep
|
||
|
|
in [ label "rule" . filenames . Build.block entry ]
|
||
|
|
|
||
|
|
(* Test: logrotate_block *)
|
||
|
|
test logrotate_block get "/var/log/wtmp\n/var/log/wtmp2\n{
|
||
|
|
missingok
|
||
|
|
monthly
|
||
|
|
}" =
|
||
|
|
{ "rule"
|
||
|
|
{ "file" = "/var/log/wtmp" }
|
||
|
|
{ "file" = "/var/log/wtmp2" }
|
||
|
|
{ "missingok" }
|
||
|
|
{ "monthly" }
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: COMBINATORICS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(* View: combine_two
|
||
|
|
A minimalistic combination lens *)
|
||
|
|
let combine_two =
|
||
|
|
let entry (k:string) = [ key k ]
|
||
|
|
in Build.combine_two (entry "a") (entry "b")
|
||
|
|
|
||
|
|
(* Test: combine_two
|
||
|
|
Should parse ab *)
|
||
|
|
test combine_two get "ab" = { "a" } { "b" }
|
||
|
|
|
||
|
|
(* Test: combine_two
|
||
|
|
Should parse ba *)
|
||
|
|
test combine_two get "ba" = { "b" } { "a" }
|
||
|
|
|
||
|
|
(* Test: combine_two
|
||
|
|
Should not parse a *)
|
||
|
|
test combine_two get "a" = *
|
||
|
|
|
||
|
|
(* Test: combine_two
|
||
|
|
Should not parse b *)
|
||
|
|
test combine_two get "b" = *
|
||
|
|
|
||
|
|
(* Test: combine_two
|
||
|
|
Should not parse aa *)
|
||
|
|
test combine_two get "aa" = *
|
||
|
|
|
||
|
|
(* Test: combine_two
|
||
|
|
Should not parse bb *)
|
||
|
|
test combine_two get "bb" = *
|
||
|
|
|
||
|
|
|
||
|
|
(* View: combine_two_opt
|
||
|
|
A minimalistic optional combination lens *)
|
||
|
|
let combine_two_opt =
|
||
|
|
let entry (k:string) = [ key k ]
|
||
|
|
in Build.combine_two_opt (entry "a") (entry "b")
|
||
|
|
|
||
|
|
(* Test: combine_two_opt
|
||
|
|
Should parse ab *)
|
||
|
|
test combine_two_opt get "ab" = { "a" } { "b" }
|
||
|
|
|
||
|
|
(* Test: combine_two_opt
|
||
|
|
Should parse ba *)
|
||
|
|
test combine_two_opt get "ba" = { "b" } { "a" }
|
||
|
|
|
||
|
|
(* Test: combine_two_opt
|
||
|
|
Should parse a *)
|
||
|
|
test combine_two_opt get "a" = { "a" }
|
||
|
|
|
||
|
|
(* Test: combine_two_opt
|
||
|
|
Should parse b *)
|
||
|
|
test combine_two_opt get "b" = { "b" }
|
||
|
|
|
||
|
|
(* Test: combine_two_opt
|
||
|
|
Should not parse aa *)
|
||
|
|
test combine_two_opt get "aa" = *
|
||
|
|
|
||
|
|
(* Test: combine_two_opt
|
||
|
|
Should not parse bb *)
|
||
|
|
test combine_two_opt get "bb" = *
|
||
|
|
|
||
|
|
|
||
|
|
(* View: combine_three
|
||
|
|
A minimalistic optional combination lens *)
|
||
|
|
let combine_three =
|
||
|
|
let entry (k:string) = [ key k ]
|
||
|
|
in Build.combine_three (entry "a") (entry "b") (entry "c")
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should not parse ab *)
|
||
|
|
test combine_three get "ab" = *
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should not parse ba *)
|
||
|
|
test combine_three get "ba" = *
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should not parse a *)
|
||
|
|
test combine_three get "a" = *
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should not parse b *)
|
||
|
|
test combine_three get "b" = *
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should not parse aa *)
|
||
|
|
test combine_three get "aa" = *
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should not parse bbc *)
|
||
|
|
test combine_three get "bbc" = *
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should parse abc *)
|
||
|
|
test combine_three get "abc" = { "a" } { "b" } { "c" }
|
||
|
|
|
||
|
|
(* Test: combine_three
|
||
|
|
Should parse cab *)
|
||
|
|
test combine_three get "cab" = { "c" } { "a" } { "b" }
|
||
|
|
|
||
|
|
|
||
|
|
(* View: combine_three_opt
|
||
|
|
A minimalistic optional combination lens *)
|
||
|
|
let combine_three_opt =
|
||
|
|
let entry (k:string) = [ key k ]
|
||
|
|
in Build.combine_three_opt (entry "a") (entry "b") (entry "c")
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should parse ab *)
|
||
|
|
test combine_three_opt get "ab" = { "a" } { "b" }
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should parse ba *)
|
||
|
|
test combine_three_opt get "ba" = { "b" } { "a" }
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should parse a *)
|
||
|
|
test combine_three_opt get "a" = { "a" }
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should parse b *)
|
||
|
|
test combine_three_opt get "b" = { "b" }
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should not parse aa *)
|
||
|
|
test combine_three_opt get "aa" = *
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should not parse bbc *)
|
||
|
|
test combine_three_opt get "bbc" = *
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should parse abc *)
|
||
|
|
test combine_three_opt get "abc" = { "a" } { "b" } { "c" }
|
||
|
|
|
||
|
|
(* Test: combine_three_opt
|
||
|
|
Should parse cab *)
|
||
|
|
test combine_three_opt get "cab" = { "c" } { "a" } { "b" }
|