qchecks for Levenshtein

_oasis

@@ -98,6 +98,14 @@ Executable bench_conv
   MainIs: bench_conv.ml
   BuildDepends: containers,benchmark
 
+Executable test_levenshtein
+  Path: tests/
+  Install: false
+  CompiledObject: native
+  Build$: flag(tests)
+  MainIs: test_levenshtein.ml
+  BuildDepends: containers,qcheck
+
 Test all
   Command: $run_tests
   TestTools: run_tests

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 47b2b524d1884245470e1a1a6acb3e85)
+# DO NOT EDIT (digest: fd301883fcfa23aed3844fd6b7def7d7)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -83,6 +83,11 @@
 "tests/bench_conv.native": package(benchmark)
 "tests/bench_conv.native": package(unix)
 <tests/*.ml{,i}>: package(benchmark)
+# Executable test_levenshtein
+"tests/test_levenshtein.native": use_containers
+"tests/test_levenshtein.native": package(qcheck)
+"tests/test_levenshtein.native": package(unix)
+<tests/*.ml{,i}>: package(qcheck)
 # Executable run_tests
 "tests/run_tests.native": use_containers
 "tests/run_tests.native": package(threads)

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.0 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 6434f259ac3da73977f0b444b8699a51) *)
+(* DO NOT EDIT (digest: 5453440881a31ee76ccdea04c48398ff) *)
 (*
    Regenerated by OASIS v0.4.0
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -7112,6 +7112,38 @@ let setup_t =
                       bs_nativeopt = [(OASISExpr.EBool true, [])]
                    },
                    {exec_custom = false; exec_main_is = "bench_conv.ml"});
+               Executable
+                 ({
+                     cs_name = "test_levenshtein";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      bs_build =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EFlag "tests", true)
+                        ];
+                      bs_install = [(OASISExpr.EBool true, false)];
+                      bs_path = "tests/";
+                      bs_compiled_object = Native;
+                      bs_build_depends =
+                        [
+                           InternalLibrary "containers";
+                           FindlibPackage ("qcheck", None)
+                        ];
+                      bs_build_tools = [ExternalTool "ocamlbuild"];
+                      bs_c_sources = [];
+                      bs_data_files = [];
+                      bs_ccopt = [(OASISExpr.EBool true, [])];
+                      bs_cclib = [(OASISExpr.EBool true, [])];
+                      bs_dlllib = [(OASISExpr.EBool true, [])];
+                      bs_dllpath = [(OASISExpr.EBool true, [])];
+                      bs_byteopt = [(OASISExpr.EBool true, [])];
+                      bs_nativeopt = [(OASISExpr.EBool true, [])]
+                   },
+                   {exec_custom = false; exec_main_is = "test_levenshtein.ml"
+                   });
                Executable
                  ({
                      cs_name = "run_tests";
@@ -7241,8 +7273,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.0";
-     oasis_digest =
-       Some "L\140\171S\252\246\195\233`\170D\014\135\031\000\162";
+     oasis_digest = Some "\243\1810yk\175ZZ\026\212L]\250\023S\177";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7250,6 +7281,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7254 "setup.ml"
+# 7285 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

tests/test_levenshtein.ml

@@ -0,0 +1,63 @@
+(* quickcheck for Levenshtein *)
+
+(* test that automaton accepts its string *)
+let test_automaton =
+  let gen = QCheck.Arbitrary.(map string (fun s -> s, Levenshtein.of_string ~limit:1 s)) in
+  let test (s,a) =
+    Levenshtein.match_with a s
+  in
+  let pp (s,_) = s in
+  let name = "string accepted by its own automaton" in
+  QCheck.mk_test ~name ~pp ~size:(fun (s,_)->String.length s) gen test
+
+(* test that building a from s, and mutating one char of s, yields
+   a string s' that is accepted by a *)
+let test_mutation =
+  (* generate triples (s, i, c) where c is a char, s a non empty string
+     and i a valid index in s *)
+  let gen = QCheck.Arbitrary.(
+    int_range ~start:3 ~stop:10 >>= fun len ->
+    int (len-1) >>= fun i ->
+    string_len (return len) >>= fun s ->
+    char >>= fun c ->
+    return (s,i,c)
+  ) in
+  let test (s,i,c) =
+    let s' = String.copy s in
+    s'.[i] <- c;
+    let a = Levenshtein.of_string ~limit:1 s in
+    Levenshtein.match_with a s'
+  in
+  let name = "mutating s.[i] into s' still accepted by automaton(s)" in
+  QCheck.mk_test ~name ~size:(fun (s,_,_)->String.length s) gen test
+
+(* test that, for an index, all retrieved strings are at a distance to
+   the key that is not too high *)
+let test_index =
+  let gen = QCheck.Arbitrary.(
+    list string >>= fun l ->
+    let l = List.map (fun s->s,s) l in
+    return (List.map fst l, Levenshtein.Index.of_list l)
+  ) in
+  let test (l, idx) =
+    List.for_all
+      (fun s ->
+        let retrieved = Levenshtein.Index.retrieve ~limit:2 idx s
+          |> Levenshtein.klist_to_list in
+        List.for_all
+          (fun s' -> Levenshtein.edit_distance s s' <= 2) retrieved
+      ) l
+  in
+  let name = "strings retrieved from automaton with limit:n are at distance <= n" in
+  QCheck.mk_test ~name gen test
+
+let suite =
+  [ test_automaton
+  ; test_mutation
+  ; test_index
+  ]
+
+let () =
+  if not (QCheck.run_tests suite)
+    then exit 1;
+  ()