Browse Source

Fixes failing tests due to bad comparison

 + The function to remove doubled entries was misfunctioning, and some test
 failed. The issue comes from the use of the polymorphic equality ("="). Indeed,
 it considers two objects equal only if they have exactly the same memory
 representation, thought we expect two entry to be equal iff they have the same
 command and tag.
 + To solve the problem, we add binary methods to several classes, allowing to
 know whether two objects are equal or not.
 + We create corresponding comparison function in module Rc, to use as
 custom comparator with OUnit and avoid other fail due two the same
 problem of the polymorphic equality.

 + We redefined tag class too, to allow to take multiple arguments + 2 new
 methods to get it (via map and new object only if new ).

 + The make_uniq function is less polymorphic, working only with object with
 proper method.

 + Resources:
 https://realworldocaml.org/v1/en/html/classes.html#binary-methods
Leo 8 years ago
parent
commit
6e5dd9d26c
7 changed files with 45 additions and 12 deletions
  1. 21 3
      src/rc.ml
  2. 11 2
      src/rc.mli
  3. 1 1
      src/test/ec_t.ml
  4. 1 1
      src/test/edit_t.ml
  5. 9 3
      src/test/unify_t.ml
  6. 1 1
      src/unify.ml
  7. 1 1
      src/unify.mli

+ 21 - 3
src/rc.ml

@@ -141,12 +141,19 @@ let entry_of_object entry =
 (* Now transformed objects *)
 
 (* Tags may be extend by plugins *)
-class tag name arg = object
+class tag name arg = object (self:'self)
   val name : string = name
-  val arguments : string = arg
+  val arguments : string list = arg
+
+  method name = name
+  method arguments = arg
+
+  method equal (other:'self) =
+    (String.equal self#name other#name)
+    && (List.equal ~equal:String.equal self#arguments other#arguments)
 end;;
 
-class entry ?(tags=[]) command = object
+class entry ?(tags=[]) command = object (self:'self)
   val command : string = command
   val tags : tag list = tags
 
@@ -155,8 +162,19 @@ class entry ?(tags=[]) command = object
 
   method change_command new_command = {< command = new_command >}
   method change_tags new_tags = {< tags = new_tags >}
+
+  (* Two entries are equal iff they have the same command and tags *)
+  method equal (other:'self) =
+    (String.equal self#command other#command)
+    && (List.equal self#tags other#tags
+      ~equal:(fun atag btag -> atag#equal btag))
 end;;
 
+(* XXX Pseudo comparator *)
+let equal one another =
+  one#equal another
+;;
+
 (* Types of objects, exposed *)
 type setting = < key : string; value : string >;;
 type t = <

+ 11 - 2
src/rc.mli

@@ -45,9 +45,17 @@ module Test :
 
 val welcome_msg : string
 
+val equal : < equal : 'a -> bool; .. > -> 'a -> bool
+
 (* TODO Improve documentation *)
-class tag :
-  string -> string -> object val arguments : string val name : string end
+class tag : string -> string list ->
+  object ('a)
+    val arguments : string list
+    val name : string
+    method arguments : string list
+    method name : string
+    method equal : 'a -> bool
+end
 class entry : ?tags:tag list -> string ->
 object ('a)
   val command : string
@@ -56,6 +64,7 @@ object ('a)
   method tags : tag list
   method change_command : string -> 'a
   method change_tags : tag list -> 'a
+  method equal : 'a -> bool
 end
 type setting = < key : string; value : string >;;
 type t = <

+ 1 - 1
src/test/ec_t.ml

@@ -45,7 +45,7 @@ let epur () =
     |> Edit_command.epur
   in
   let expected = List.map ~f:Tools.to_entry [ "qw" ; "erty" ; "a" ; "zerty" ] in
-  OUnit.assert_equal current expected
+  OUnit.assert_equal ~cmp:(List.equal ~equal:Rc.equal) current expected
 ;;
 
 (* Function gen_modification *)

+ 1 - 1
src/test/edit_t.ml

@@ -41,7 +41,7 @@ open Core.Std;;
 (* Function epur ============================= *)
 let epur test solution () =
   let actual = Edit_command.epur test in
-  OUnit.assert_equal actual solution
+  OUnit.assert_equal ~cmp:(List.equal ~equal:Rc.equal) actual solution
 ;;
 
 (* Data for above test *)

+ 9 - 3
src/test/unify_t.ml

@@ -41,7 +41,7 @@ open Core.Std;;
 (* Function make_uniq ============================= *)
 let make_uniq test solution () =
   let actual = Unify.make_uniq test in
-  OUnit.assert_equal actual solution
+  OUnit.assert_equal ~cmp:(List.equal ~equal:Rc.equal) actual solution
 ;;
 
 (* Big and sometimes strange list, to be used in test data set.
@@ -109,7 +109,10 @@ let make_uniq_data = [
 ;;
 
 let t_set_fast =
-  List.map make_uniq_data ~f:(fun (t, s, name) -> ( (make_uniq t s), name))
+  List.map make_uniq_data ~f:(fun (t, s, name) -> (
+    let t = List.map ~f:Tools.to_entry t in
+    let s = List.map ~f:Tools.to_entry s in
+    (make_uniq t s), name))
   |> List.map ~f:(fun ( f,name ) -> (name, `Quick, f))
 ;;
 
@@ -117,7 +120,10 @@ let t_set_long =
   List.map
     ((big_pack ~message:"Much longer than real use case list of " 1_000)
      @ (big_pack ~message:"Crazy long list of " 9_999))
-    ~f:(fun (t, s, name) -> ( (make_uniq t s), name))
+    ~f:(fun (t, s, name) ->
+    let t = List.map ~f:Tools.to_entry t in
+    let s = List.map ~f:Tools.to_entry s in
+      ( (make_uniq t s), name))
   |> List.map ~f:(fun ( f,name ) -> (name, `Slow, f))
 ;;
 

+ 1 - 1
src/unify.ml

@@ -48,7 +48,7 @@ open Core.Std;;
 let make_uniq dubbled_entries =
   let seen = ref [] in (* Entries already added *)
   List.(filter dubbled_entries ~f:(fun entry ->
-         (exists !seen ~f:(fun in_seen -> in_seen = entry)) |> function
+         (exists !seen ~f:(fun in_seen -> in_seen#equal entry)) |> function
          | false -> (* Entry not already seen, keep it *)
            seen := (entry :: !seen); true
          (* Already kept, discard *)

+ 1 - 1
src/unify.mli

@@ -36,6 +36,6 @@
 
 open Core.Std;;
 
-val make_uniq : 'a list -> 'a list
+val make_uniq : (< equal : 'a -> bool; .. > as 'a) list -> 'a list
 val prettify_cmd : Rc.entry list -> Rc.entry list
 val prettify : Rc.t -> Rc.t