···1414let record fields = Record fields
1515let enum x = Enum x
1616let string s = String s
1717+1818+let result ok err = function
1919+ | Ok s -> variant "Ok" [ ok s ]
2020+ | Error e -> variant "Error" [ err e ]
2121+;;
2222+2323+let option f = function
2424+ | None -> enum "None"
2525+ | Some s -> variant "Some" [ f s ]
2626+;;
-10
lib/fmt.ml
···3737 | Some i -> fprintf fmt "@ %d" i
3838;;
39394040-let quote fmt s = Format.fprintf fmt "\"%s\"" s
4141-4242-let pp_olist pp_elem fmt =
4343- Format.fprintf
4444- fmt
4545- "@[<3>[@ %a@ ]@]"
4646- (pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ";@ ") pp_elem)
4747-;;
4848-4940let char fmt c = Format.fprintf fmt "%c" c
5041let bool = Format.pp_print_bool
5151-let pp_str_list = pp_olist quote
5242let lit s fmt () = pp_print_string fmt s
53435444let to_to_string pp x =
-1
lib/fmt.mli
···11type formatter := Format.formatter
22type 'a t = formatter -> 'a -> unit
3344-val pp_str_list : string list t
54val sexp : formatter -> string -> 'a t -> 'a -> unit
65val str : string t
76val optint : int option t
···11-(* ounit compatibility layer for fort tests *)
22-open OUnit2
33-44-type ('a, 'b) either =
55- | Left of 'a
66- | Right of 'b
77-88-let str_of_either f g = function
99- | Left a -> f a
1010- | Right b -> g b
1111-;;
1212-1313-let try_with f =
1414- try Right (f ()) with
1515- | exn -> Left exn
1616-;;
1717-1818-let expect_equal_app ?printer ?msg f x g y =
1919- let fx = try_with (fun () -> f x) in
2020- let gy = try_with (fun () -> g y) in
2121- let printer =
2222- let right x =
2323- match printer with
2424- | None -> "<no printer>"
2525- | Some p -> p x
2626- in
2727- str_of_either Printexc.to_string right
2828- in
2929- assert_equal ~printer ?msg fx gy
3030-;;
3131-3232-let collected_tests = ref []
3333-let id x = x
3434-let not_found () = raise Not_found
3535-let bool_printer i = Printf.sprintf "%b" i
3636-let int_printer i = Printf.sprintf "%d" i
3737-let str_printer s = "\"" ^ String.escaped s ^ "\""
3838-let ofs_printer (i0, i1) = Printf.sprintf "(%d,%d)" i0 i1
3939-let list_printer f l = "[" ^ String.concat "; " (List.map f l) ^ "]"
4040-let arr_printer f a = "[|" ^ String.concat "; " (List.map f (Array.to_list a)) ^ "|]"
4141-4242-let opt_printer f = function
4343- | None -> "<None>"
4444- | Some s -> "Some (" ^ f s ^ ")"
4545-;;
4646-4747-let arr_str_printer = arr_printer str_printer
4848-let arr_ofs_printer = arr_printer ofs_printer
4949-let list_ofs_printer = list_printer ofs_printer
5050-let fail = assert_failure
5151-let expect_eq_bool ?msg f x g y = expect_equal_app ?msg ~printer:string_of_bool f x g y
5252-let expect_eq_str ?msg f x g y = expect_equal_app ?msg ~printer:str_printer f x g y
5353-5454-let expect_eq_str_opt ?msg f x g y =
5555- expect_equal_app ?msg ~printer:(opt_printer str_printer) f x g y
5656-;;
5757-5858-let expect_eq_ofs ?msg f x g y = expect_equal_app ?msg ~printer:ofs_printer f x g y
5959-6060-let expect_eq_arr_str ?msg f x g y =
6161- expect_equal_app ?msg ~printer:arr_str_printer f x g y
6262-;;
6363-6464-let expect_eq_arr_ofs ?msg f x g y =
6565- expect_equal_app ?msg ~printer:arr_ofs_printer f x g y
6666-;;
6767-6868-let expect_eq_list_str ?msg f x g y =
6969- expect_equal_app ?msg ~printer:(list_printer str_printer) f x g y
7070-;;
7171-7272-let expect_pass name run =
7373- collected_tests := (name >:: fun _ -> run ()) :: !collected_tests
7474-;;
7575-7676-let run_test_suite suite_name = run_test_tt_main (suite_name >::: !collected_tests)
-3
lib_test/str/dune
···11-(test
22- (libraries re fort_unit str ounit2)
33- (name test_str))
-276
lib_test/str/test_str.ml
···11-open Fort_unit
22-open OUnit2
33-44-module type Str_intf = module type of Str
55-66-module Test_matches (R : Str_intf) = struct
77- let groups () =
88- let group i =
99- try `Found (R.group_beginning i) with
1010- | Not_found -> `Not_found
1111- | Invalid_argument _ -> `Not_exists
1212- in
1313- let rec loop acc i =
1414- match group i with
1515- | `Found p -> loop ((p, R.group_end i) :: acc) (i + 1)
1616- | `Not_found -> loop ((-1, -1) :: acc) (i + 1)
1717- | `Not_exists -> List.rev acc
1818- in
1919- loop [] 0
2020- ;;
2121-2222- let eq_match ?(pos = 0) ?(case = true) r s =
2323- let pat = if case then R.regexp r else R.regexp_case_fold r in
2424- try
2525- ignore (R.search_forward pat s pos);
2626- Some (groups ())
2727- with
2828- | Not_found -> None
2929- ;;
3030-3131- let eq_match' ?(pos = 0) ?(case = true) r s =
3232- let pat = if case then R.regexp r else R.regexp_case_fold r in
3333- try
3434- ignore (R.string_match pat s pos);
3535- Some (groups ())
3636- with
3737- | Not_found -> None
3838- ;;
3939-end
4040-4141-module T_str = Test_matches (Str)
4242-module T_re = Test_matches (Re.Str)
4343-4444-let eq_match ?pos ?case r s =
4545- expect_equal_app
4646- ~msg:(str_printer s)
4747- ~printer:(opt_printer (list_printer ofs_printer))
4848- (fun () -> T_str.eq_match ?pos ?case r s)
4949- ()
5050- (fun () -> T_re.eq_match ?pos ?case r s)
5151- ()
5252-;;
5353-5454-let eq_match' ?pos ?case r s =
5555- expect_equal_app
5656- ~msg:(str_printer s)
5757- ~printer:(opt_printer (list_printer ofs_printer))
5858- (fun () -> T_str.eq_match' ?pos ?case r s)
5959- ()
6060- (fun () -> T_re.eq_match' ?pos ?case r s)
6161- ()
6262-;;
6363-6464-let split_result_conv =
6565- List.map (function
6666- | Str.Delim x -> Re.Str.Delim x
6767- | Str.Text x -> Re.Str.Text x)
6868-;;
6969-7070-let pp_split_result_list =
7171- Fmt.pp_olist (fun fmt x ->
7272- let tag, arg =
7373- match x with
7474- | Re.Str.Delim x -> "Delim", x
7575- | Re.Str.Text x -> "Text", x
7676- in
7777- Fmt.fprintf fmt "%s@ (\"%s\")" tag arg)
7878-;;
7979-8080-let pp_fs pp_args pp_out fmt (name, re, args, ex, res) =
8181- let f fmt (mod_, r) =
8282- Fmt.fprintf fmt "%s.%s %a %a = %a" mod_ name Fmt.quote re pp_args args pp_out r
8383- in
8484- Fmt.fprintf fmt "@.%a@.%a" f ("Str", ex) f ("Re.Str", res)
8585-;;
8686-8787-type ('a, 'b) test =
8888- { name : string
8989- ; pp_args : 'a Fmt.t
9090- ; pp_out : 'b Fmt.t
9191- ; re_str : Re.Str.regexp -> 'a -> 'b
9292- ; str : Str.regexp -> 'a -> 'b
9393- }
9494-9595-let bounded_split_t =
9696- { name = "bounded_split"
9797- ; pp_args = (fun fmt (s, n) -> Fmt.fprintf fmt "%a %d" Fmt.quote s n)
9898- ; pp_out = Fmt.pp_str_list
9999- ; re_str = (fun re (s, n) -> Re.Str.bounded_split re s n)
100100- ; str = (fun re (s, n) -> Str.bounded_split re s n)
101101- }
102102-;;
103103-104104-let bounded_full_split_t =
105105- { bounded_split_t with
106106- name = "bounded_full_split"
107107- ; pp_out = pp_split_result_list
108108- ; re_str = (fun re (s, n) -> Re.Str.bounded_full_split re s n)
109109- ; str = (fun re (s, n) -> split_result_conv (Str.bounded_full_split re s n))
110110- }
111111-;;
112112-113113-let full_split_t =
114114- { bounded_full_split_t with
115115- name = "full_split"
116116- ; pp_args = (fun fmt s -> Fmt.fprintf fmt "%a" Fmt.quote s)
117117- ; re_str = (fun re s -> Re.Str.full_split re s)
118118- ; str = (fun re s -> split_result_conv (Str.full_split re s))
119119- }
120120-;;
121121-122122-let split_delim_t =
123123- { full_split_t with
124124- name = "split_delim"
125125- ; pp_out = Fmt.pp_str_list
126126- ; re_str = (fun re s -> Re.Str.split_delim re s)
127127- ; str = (fun re s -> Str.split_delim re s)
128128- }
129129-;;
130130-131131-let split_t =
132132- { name = "split"
133133- ; pp_out = Fmt.pp_str_list
134134- ; pp_args = full_split_t.pp_args
135135- ; re_str = (fun re s -> Re.Str.split re s)
136136- ; str = (fun re s -> Str.split re s)
137137- }
138138-;;
139139-140140-let global_replace_t =
141141- { name = "global_replace"
142142- ; pp_out = Fmt.pp_print_string
143143- ; pp_args = (fun fmt (r, s) -> Fmt.fprintf fmt "%a %a" Fmt.quote r Fmt.quote s)
144144- ; re_str = (fun re (r, s) -> Re.Str.global_replace re r s)
145145- ; str = (fun re (r, s) -> Str.global_replace re r s)
146146- }
147147-;;
148148-149149-let test t re args =
150150- assert_equal
151151- ~pp_diff:(fun fmt (ex, act) ->
152152- pp_fs t.pp_args t.pp_out fmt (t.name, re, args, ex, act))
153153- ~printer:(Fmt.to_to_string t.pp_out)
154154- (t.re_str (Re.Str.regexp re) args)
155155- (t.str (Str.regexp re) args)
156156-;;
157157-158158-let split_delim re s = test split_delim_t re s
159159-let split re s = test split_t re s
160160-let full_split re s = test full_split_t re s
161161-let bounded_split re s n = test bounded_split_t re (s, n)
162162-let bounded_full_split re s n = test bounded_full_split_t re (s, n)
163163-let global_replace re r s = test global_replace_t re (r, s)
164164-165165-let _ =
166166- (* Literal Match *)
167167- expect_pass "str" (fun () ->
168168- eq_match "a" "a";
169169- eq_match "a" "b");
170170- (* Basic Operations *)
171171- expect_pass "alt" (fun () ->
172172- eq_match "a\\|b" "a";
173173- eq_match "a\\|b" "b";
174174- eq_match "a\\|b" "c");
175175- expect_pass "seq" (fun () ->
176176- eq_match "ab" "ab";
177177- eq_match "ab" "ac");
178178- expect_pass "epsilon" (fun () ->
179179- eq_match "" "";
180180- eq_match "" "a");
181181- expect_pass "rep" (fun () ->
182182- eq_match "a*" "";
183183- eq_match "a*" "a";
184184- eq_match "a*" "aa";
185185- eq_match "a*" "b");
186186- expect_pass "rep1" (fun () ->
187187- eq_match "a+" "a";
188188- eq_match "a+" "aa";
189189- eq_match "a+" "";
190190- eq_match "a+" "b");
191191- expect_pass "opt" (fun () ->
192192- eq_match "a?" "";
193193- eq_match "a?" "a");
194194- (* String, line, word *)
195195- expect_pass "bol" (fun () ->
196196- eq_match "^a" "ab";
197197- eq_match "^a" "b\na";
198198- eq_match "^a" "ba");
199199- expect_pass "eol" (fun () ->
200200- eq_match "a$" "ba";
201201- eq_match "a$" "a\nb";
202202- eq_match "a$" "ba\n";
203203- eq_match "a$" "ab");
204204- expect_pass "start" (fun () ->
205205- eq_match ~pos:1 "Za" "xab";
206206- eq_match ~pos:1 "Za" "xb\na";
207207- eq_match ~pos:1 "Za" "xba");
208208- (* Match semantics *)
209209- expect_pass "match semantics" (fun () ->
210210- eq_match "\\(a\\|b\\)*b" "aabaab";
211211- eq_match "aa\\|aaa" "aaaa";
212212- eq_match "aaa\\|aa" "aaaa");
213213- (* Group (or submatch) *)
214214-215215- (* TODO: infinite loop *)
216216- expect_pass "group" (fun () -> eq_match "\\(a\\)\\(a\\)?\\(b\\)" "ab");
217217- (* Character set *)
218218- expect_pass "rg" (fun () ->
219219- eq_match "[0-9]+" "0123456789";
220220- eq_match "[0-9]+" "a";
221221- eq_match "[9-0]+" "2";
222222- eq_match "[5-5]" "5";
223223- eq_match "[5-4]" "1";
224224- eq_match' "[]]" "]";
225225- eq_match' "[a-]" "-";
226226- eq_match' "[-a]" "-";
227227- eq_match' "]" "]";
228228- eq_match' "[^b-f]" "z";
229229- eq_match' "[^b-f]" "a"
230230- (* These errors aren't correct *)
231231- (* eq_match' "[]" "x" *)
232232- (* eq_match' "[" "[" *));
233233- expect_pass "compl" (fun () ->
234234- eq_match "[^0-9a-z]+" "A:Z+";
235235- eq_match "[^0-9a-z]+" "0";
236236- eq_match "[^0-9a-z]+" "a");
237237- (* Word modifiers *)
238238- expect_pass "word boundaries" (fun () ->
239239- eq_match' "\\bfoo" "foo";
240240- eq_match' "\\<foo" "foo";
241241- eq_match' "foo\\>" "foo";
242242- eq_match' "z\\Bfoo" "zfoo";
243243- eq_match' "\\`foo" "foo";
244244- eq_match' "foo\\'" "foo");
245245- (* Case modifiers *)
246246- expect_pass "no_case" (fun () ->
247247- eq_match ~case:false "abc" "abc";
248248- eq_match ~case:false "abc" "ABC");
249249- expect_pass "global_replace" (fun () ->
250250- global_replace "needle" "test" "needlehaystack";
251251- global_replace "needle" "" "";
252252- global_replace "needle" "" "needle";
253253- global_replace "xxx" "yyy" "zzz";
254254- global_replace "test\\([0-9]*\\)" "\\1-foo-\\1" "test100 test200 test";
255255- global_replace "test\\([0-9]*\\)" "'\\-0'" "test100 test200 test";
256256- (* Regrssion test for #129 *)
257257- global_replace "\\(X+\\)" "A\\1YY" "XXXXXXZZZZ");
258258- expect_pass "bounded_split, bounded_full_split" (fun () ->
259259- List.iter
260260- (fun (re, s, n) ->
261261- bounded_full_split re s n;
262262- bounded_split re s n)
263263- [ ",", "foo,bar,baz", 5
264264- ; ",", "foo,bar,baz", 1
265265- ; ",", "foo,bar,baz", 0
266266- ; ",\\|", "foo,bar|baz", 4
267267- ]);
268268- expect_pass "split, full_split, split_delim" (fun () ->
269269- List.iter
270270- (fun (re, s) ->
271271- split re s;
272272- full_split re s;
273273- split_delim re s)
274274- [ "re", ""; " ", "foo bar"; "\b", "one-two three"; "[0-9]", "One3TwoFive" ]);
275275- run_test_suite "test_str"
276276-;;