(* Module: Test_Build Provides unit tests and examples for the 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 *) test block get " {test=1}" = { "test" = "1" } (* Test: block Simple test for with newlines *) test block get " {\n test=1\n}" = { "test" = "1" } (* Test: block Simple test for two indented entries *) test block get " {\n test=1 \n test=2 \n}" = { "test" = "1" } { "test" = "2" } (* Test: block Test with a comment *) test block get " { # This is a comment\n}" = { "#comment" = "This is a comment" } (* Test: block Test 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 *) 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" }