Shell: add unit tests for Merkle tree

.gitignore

@@ -42,6 +42,7 @@
 /test/test-context
 /test/test-basic
 /test/test-data-encoding
+/test/test-merkle
 /test/test-p2p-io-scheduler
 /test/test-p2p-connection
 /test/test-p2p-connection-pool

.gitlab-ci.yml

@@ -86,6 +86,15 @@ test:data-encoding:
   dependencies:
     - build
 
+test:merkle:
+  stage: test
+  tags:
+    - tezos_builder
+  script:
+    - make -C test run-test-merkle
+  dependencies:
+    - build
+
 test:p2p-io-scheduler:
   stage: test
   tags:

src/utils/hash.mli

@@ -175,3 +175,22 @@ module Operation_list_list_hash :
 module Protocol_hash : INTERNAL_HASH
 
 module Generic_hash : INTERNAL_MINIMAL_HASH
+
+(**/**)
+
+module Generic_Merkle_tree (H : sig
+    type t
+    type elt
+    val encoding : t Data_encoding.t
+    val empty : t
+    val leaf : elt -> t
+    val node : t -> t -> t
+  end) : sig
+  val compute : H.elt list -> H.t
+  type path =
+    | Left of path * H.t
+    | Right of H.t * path
+    | Op
+  val compute_path: H.elt list -> int -> path
+  val check_path: path -> H.elt -> H.t * int
+end

test/Makefile

@@ -1,5 +1,6 @@
 
 TESTS := \
+  merkle \
   data-encoding \
   store context state \
   basic basic.sh \
@@ -246,6 +247,29 @@ test-lwt-pipe: ${NODELIB} ${TEST_PIPE_IMPLS:.ml=.cmx}
 clean::
 	rm -f test-p2p
 
+############################################################################
+## Merkle test program
+
+.PHONY:build-test-merkle run-test-merkle
+build-test-merkle: test-merkle
+run-test-merkle:
+	./test-merkle
+
+TEST_MERKLE_INTFS =
+
+TEST_MERKLE_IMPLS = \
+  lib/assert.ml \
+  lib/test.ml \
+  test_merkle.ml
+
+${TEST_MERKLE_IMPLS:.ml=.cmx}: ${NODELIB}
+test-merkle: ${NODELIB} ${TEST_MERKLE_IMPLS:.ml=.cmx}
+	ocamlfind ocamlopt -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^
+
+clean::
+	rm -f test-merkle
+
+
 ############################################################################
 ## data encoding test program
 

test/test_merkle.ml

@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+open Hash
+
+let rec (--) i j =
+  if j < i then []
+  else i :: (i+1) -- j
+
+type tree =
+  | Empty
+  | Leaf of int
+  | Node of tree * tree
+
+let rec list_of_tree = function
+  | Empty -> [], 0
+  | Leaf x -> [x], 1
+  | Node (x, y) ->
+      let x, sx = list_of_tree x
+      and y, sy = list_of_tree y in
+      assert (sx = sy) ;
+      x @ y, sx + sy
+
+module Merkle = Hash.Generic_Merkle_tree(struct
+    type t = tree
+    type elt = int
+    let empty = Empty
+    let leaf i = Leaf i
+    let node x y = Node (x, y)
+    let encoding =
+      (* Fake... *)
+      Data_encoding.conv (fun _ -> 0) (fun _ -> Empty) Data_encoding.int31
+  end)
+
+let rec compare_list xs ys =
+  match xs, ys with
+  | [], [] -> true
+  | [x], y :: ys when x = y -> ys = [] || compare_list xs ys
+  | x :: xs, y :: ys when x = y -> compare_list xs ys
+  | _, _ -> false
+
+let check_size i =
+  let l = 0 -- i in
+  let l2, _ = list_of_tree (Merkle.compute l) in
+  if compare_list l l2 then
+    return ()
+  else
+    failwith "Failed for %d: %a"
+      i
+      (Format.pp_print_list
+         ~pp_sep:(fun ppf () -> Format.pp_print_string ppf ";")
+         Format.pp_print_int)
+      l2
+
+let test_compute _ =
+  iter_s check_size (0--99)
+
+let check_path i =
+  let l = 0 -- i in
+  let orig = Merkle.compute l in
+  iter_s (fun j ->
+      let path = Merkle.compute_path l j in
+      let found, pos = Merkle.check_path path j in
+      if found = orig && j = pos then
+        return ()
+      else
+        failwith "Failed for %d in %d." j i)
+    l
+
+let test_path _ =
+  iter_s check_path (0--128)
+
+let tests : (string * (string -> unit tzresult Lwt.t)) list = [
+  "compute", test_compute ;
+  "path", test_path ;
+]
+
+let () =
+  Test.run "merkel." tests