Commits

Dmitry Grebeniuk  committed 1e6b895

merge_rwm tested

  • Participants
  • Parent commits 27f8eda

Comments (0)

Files changed (2)

 	$(SETUP) -doc $(DOCFLAGS)
 
 test: setup.data build
-	$(SETUP) -test $(TESTFLAGS)
+	$(SETUP) -test $(TESTFLAGS) # -verbose
 
 all: 
 	$(SETUP) -all $(ALLFLAGS)

File test/test.ml

 *)
 
 
-value map_rws_assoc_merge
+value map_rws_merge_test
 : ~flip:bool ->
   ~mk1:(unit -> Cd.Tfun.map_rws _ _) ->
   ~mk2:(unit -> Cd.Tfun.map_rws _ _) ->
   makes >>= fun (n2, mk2) ->
   scenarios_txt >>= fun (scenario, sc_txt) ->
   return &
-    (sprintf "map_rws_assoc#merge %s%s%s (%s)"
+    (sprintf "map_rws#merge %s%s%s (%s)"
       n1 (if flip then "->" else "<-") n2
       sc_txt
     )
-     >:: (fun () -> map_rws_assoc_merge ~flip ~mk1 ~mk2 ~scenario)
+     >:: (fun () -> map_rws_merge_test ~flip ~mk1 ~mk2 ~scenario)
+;
+
+
+value map_rwm_merge_test
+: ~flip:bool ->
+  ~mk1:(unit -> Cd.Tfun.map_rwm _ _) ->
+  ~mk2:(unit -> Cd.Tfun.map_rwm _ _) ->
+  ~scenario:([= `Some1 | `First_empty | `Second_empty | `Both_empty ]) ->
+  unit
+= fun ~flip ~mk1 ~mk2 ~scenario ->
+  let str_of_list : list string -> string
+    = fun lst ->
+        lst
+        |> String.concat " ; "
+        |> sprintf "[%s]"
+  in
+  let m1 = mk1 ()
+  and m2 = mk2 () in
+  let m1 =
+    match scenario with
+    [ `Some1 | `Second_empty ->
+        ((m1#add 1 "1")#add 2 "2")#add 1 "11"
+    | `First_empty | `Both_empty ->
+        m1
+    ]
+  and m2 =
+    match scenario with
+    [ `Some1 | `First_empty ->
+        (m2#add 1 "111")#add 3 "3"
+    | `Second_empty | `Both_empty ->
+        m2
+    ]
+  in
+  let (m1, m2) =
+    if flip
+    then (m2, m1)
+    else (m1, m2)
+  in
+  let m3 = m1#merge
+    (fun k v1l v2l ->
+       [ sprintf "%i: %s + %s"
+              k (str_of_list v1l) (str_of_list v2l)
+       ]
+    )
+    m2
+  in
+  let sort = List.sort compare in
+  let m3list = sort &
+    m3#fold (fun acc k v -> [(sprintf "%i => %s" k v) :: acc]) [] in
+  let expected_list = sort &
+    match (flip, scenario) with
+    [ (False, `Some1) ->
+        [ "1 => 1: [11 ; 1] + [111]"
+        ; "2 => 2: [2] + []"
+        ; "3 => 3: [] + [3]"
+        ]
+    | (False, `Second_empty) ->
+        [ "1 => 1: [11 ; 1] + []"
+        ; "2 => 2: [2] + []"
+        ]
+    | (False, `First_empty) ->
+        [ "1 => 1: [] + [111]"
+        ; "3 => 3: [] + [3]"
+        ]
+
+    | (_, `Both_empty) ->
+        [
+        ]
+
+    | (True, `Some1) ->
+        [ "1 => 1: [111] + [11 ; 1]"
+        ; "2 => 2: [] + [2]"
+        ; "3 => 3: [3] + []"
+        ]
+
+    (* результаты такие, потому что сначала заполнение m1,m2,
+       а только потом их обмен при flip=True. *)
+    | (True, `Second_empty) ->
+        [ "1 => 1: [] + [11 ; 1]"
+        ; "2 => 2: [] + [2]"
+        ]
+
+    | (True, `First_empty) ->
+        [ "1 => 1: [111] + []"
+        ; "3 => 3: [3] + []"
+        ]
+    ]
+  in
+  assert_equal
+    ~printer:printer_list_string
+    expected_list
+    m3list
+;
+
+
+value map_rwm_merge =
+  let makes =
+    [ ("assoc", fun () ->
+        new Cd.Sfun.map_rwm_assoc tint ~tval:tstring [])
+    ]
+  and scenarios_txt =
+    [ (`Some1, "Some1")
+    ; (`First_empty, "First_empty")
+    ; (`Second_empty, "Second_empty")
+    ; (`Both_empty, "Both empty")
+    ]
+  in
+  let open Cd_List.List.Monad in
+  [False; True] >>= fun flip ->
+  makes >>= fun (n1, mk1) ->
+  makes >>= fun (n2, mk2) ->
+  scenarios_txt >>= fun (scenario, sc_txt) ->
+  return &
+    (sprintf "map_rwm#merge %s%s%s (%s)"
+      n1 (if flip then "->" else "<-") n2
+      sc_txt
+    )
+     >:: (fun () -> map_rwm_merge_test ~flip ~mk1 ~mk2 ~scenario)
+;
+
+
+value maps_merge =
+    map_rws_merge
+  @ map_rwm_merge
 ;
 
 
 
     @ trie
     @ strings
-    @ map_rws_merge
+    @ maps_merge
 
     @ typedefs
     )