From 09efe4f2c17ceaa732d96bc8bc83575c93155bf1 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mbouaziz@fb.com>
Date: Thu, 27 Jun 2019 03:28:22 -0700
Subject: [PATCH] Add tests for MaximumSharing

Reviewed By: ngorogiannis

Differential Revision: D16016776

fbshipit-source-id: c96c661b1
---
 infer/src/istd/MaximumSharing.mli     | 10 ++++-
 infer/src/unit/MaximumSharingTests.ml | 60 +++++++++++++++++++++++++++
 infer/src/unit/inferunit.ml           |  1 +
 3 files changed, 69 insertions(+), 2 deletions(-)
 create mode 100644 infer/src/unit/MaximumSharingTests.ml

diff --git a/infer/src/istd/MaximumSharing.mli b/infer/src/istd/MaximumSharing.mli
index 3b5bb5f22..de8f0b2cf 100644
--- a/infer/src/istd/MaximumSharing.mli
+++ b/infer/src/istd/MaximumSharing.mli
@@ -7,13 +7,19 @@
 
 open! IStd
 
-exception MaximumSharingLazyValue
-
 (**
   Current implementation will stack overflow on deep (TODO: a tailrec version)
   or circular values (much harder to detect sharing, also not needed for now).
 *)
 
+module Sharer : sig
+  type t
+
+  val create : unit -> t
+
+  val normalize_value : t -> 'a -> 'a
+end
+
 module ForHashtbl (H : Caml.Hashtbl.S) : sig
   val normalize : 'a H.t -> 'a H.t
   (** Duplicate a hash table with maximum sharing. *)
diff --git a/infer/src/unit/MaximumSharingTests.ml b/infer/src/unit/MaximumSharingTests.ml
new file mode 100644
index 000000000..6ce233d96
--- /dev/null
+++ b/infer/src/unit/MaximumSharingTests.ml
@@ -0,0 +1,60 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+open OUnit2
+
+let inputs =
+  let a = `A 'a' in
+  let b = Array.create ~len:10_000 a in
+  let c = Array.create ~len:100 b in
+  [ ("unit", Obj.repr ())
+  ; ("same representation", Obj.repr ([42], [|42; 0|]))
+  ; ("10K times the same element", Obj.repr b)
+  ; ("100 times 10K times the same element", Obj.repr c) ]
+
+
+let tests =
+  let normalize input =
+    let sharer = MaximumSharing.Sharer.create () in
+    MaximumSharing.Sharer.normalize_value sharer input
+  in
+  let test_one input _ =
+    (* Save this now, in case `MaximumSharing` mutates the [input], even though it shouldn't *)
+    let serialized_input_with_sharing = Marshal.to_string input [] in
+    let serialized_input_no_sharing = Marshal.to_string input [Marshal.No_sharing] in
+    let reachable_words_input = Obj.reachable_words input in
+    let normalized = normalize input in
+    (*
+      We can't really check [input] hasn't been mutated but its marshalling with sharing
+      shouldn't have changed
+    *)
+    let serialized_input_with_sharing' = Marshal.to_string input [] in
+    assert_equal serialized_input_with_sharing serialized_input_with_sharing' ;
+    (*
+      The whole goal of [MaximumSharing] is to reduce the memory footprint.
+      Let's make sure this contract is fulfilled.
+      There is no guarantee the serialized version will be smaller, e.g.
+      [let x = Some 0 in (x, Array.init 254 (fun i -> Some i), x)]
+      is smaller with no sharing.
+    *)
+    let reachable_words_normalized = Obj.reachable_words normalized in
+    assert_bool "less reachable words" (reachable_words_normalized <= reachable_words_input) ;
+    let eq =
+      (* Cannot use [assert_equal] because it doesn't shortcut physical equalities *)
+      Polymorphic_compare.equal input normalized
+    in
+    assert_bool "equal" eq ;
+    (*
+      In case structural equality and marshalling have slightly different semantics,
+      let's also make sure the serialized versions are indistinguishable
+    *)
+    let serialized_normalized_no_sharing = Marshal.to_string normalized [Marshal.No_sharing] in
+    assert_equal serialized_input_no_sharing serialized_normalized_no_sharing
+  in
+  let tests_ = List.map inputs ~f:(fun (name, input) -> name >:: test_one input) in
+  "MaximumSharing_tests" >::: tests_
diff --git a/infer/src/unit/inferunit.ml b/infer/src/unit/inferunit.ml
index 897e0c97d..55cafb5e7 100644
--- a/infer/src/unit/inferunit.ml
+++ b/infer/src/unit/inferunit.ml
@@ -36,6 +36,7 @@ let () =
         ; IListTests.tests
         ; JavaProfilerSamplesTest.tests
         ; LivenessTests.tests
+        ; MaximumSharingTests.tests
         ; PerfProfilerATDParserTest.tests
         ; ProcCfgTests.tests
         ; SchedulerTests.tests