From 3ceac69079947a5e71cd0cc4a1ecd4fc273e6391 Mon Sep 17 00:00:00 2001
From: Nikos Gorogiannis <nikosg@fb.com>
Date: Thu, 3 Dec 2020 04:59:43 -0800
Subject: [PATCH] [lru] strengthen tests with key-value pair order

Summary: Tests for the LRU cache now expect a fixed order of key-value pairs in the cache where previously only the set of key-value pairs was considered.

Reviewed By: jvillard

Differential Revision: D25301133

fbshipit-source-id: 0d8077950
---
 infer/src/istd/LRUHashtbl.ml      |  5 ++++-
 infer/src/istd/LRUHashtbl.mli     |  1 +
 infer/src/unit/LRUHashtblTests.ml | 29 +++++++++++++++++++++--------
 3 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/infer/src/istd/LRUHashtbl.ml b/infer/src/istd/LRUHashtbl.ml
index 54b5fd1a1..ee55b3e9c 100644
--- a/infer/src/istd/LRUHashtbl.ml
+++ b/infer/src/istd/LRUHashtbl.ml
@@ -60,6 +60,8 @@ module Make (Key : Hashtbl.HashedType) = struct
     let remove {list} n = Doubly_linked.remove list n
 
     let clear {list} = Doubly_linked.clear list
+
+    let to_list {list} = Doubly_linked.to_list list
   end
 
   type 'a t = {map: ('a * key Doubly_linked.Elt.t) Hash.t; lru: LRU.t}
@@ -114,5 +116,6 @@ module Make (Key : Hashtbl.HashedType) = struct
     F.pp_print_string f "}"
 
 
-  let bindings {map} = Seq.fold_left (fun acc (k, (v, _node)) -> (k, v) :: acc) [] (Hash.to_seq map)
+  let bindings {map; lru} =
+    LRU.to_list lru |> List.map ~f:(fun key -> (key, Hash.find map key |> fst))
 end
diff --git a/infer/src/istd/LRUHashtbl.mli b/infer/src/istd/LRUHashtbl.mli
index a04ab1bbc..f3c338b11 100644
--- a/infer/src/istd/LRUHashtbl.mli
+++ b/infer/src/istd/LRUHashtbl.mli
@@ -32,6 +32,7 @@ module type S = sig
     -> unit
 
   val bindings : 'a t -> (key * 'a) list
+  (** visible for testing mainly; makes linear number of hashtable lookups *)
 end
 
 module Make (Key : Caml.Hashtbl.HashedType) : S with type key = Key.t
diff --git a/infer/src/unit/LRUHashtblTests.ml b/infer/src/unit/LRUHashtblTests.ml
index 868f7b6db..f80bc636d 100644
--- a/infer/src/unit/LRUHashtblTests.ml
+++ b/infer/src/unit/LRUHashtblTests.ml
@@ -17,6 +17,14 @@ let inputs =
         LRUHash.replace map 0 10 ;
         map )
     , [(0, 10)] )
+  ; ( "LRU order"
+    , (fun () ->
+        let map = LRUHash.create ~initial_size:5 ~max_size:3 in
+        LRUHash.replace map 0 10 ;
+        LRUHash.replace map 1 10 ;
+        LRUHash.replace map 2 10 ;
+        map )
+    , [(2, 10); (1, 10); (0, 10)] )
   ; ( "LRU1"
     , (fun () ->
         let map = LRUHash.create ~initial_size:5 ~max_size:3 in
@@ -27,7 +35,7 @@ let inputs =
         LRUHash.replace map 3 10 ;
         LRUHash.replace map 4 10 ;
         map )
-    , [(1, 10); (3, 10); (4, 10)] )
+    , [(4, 10); (3, 10); (1, 10)] )
   ; ( "LRU2"
     , (fun () ->
         let map = LRUHash.create ~initial_size:5 ~max_size:3 in
@@ -37,7 +45,17 @@ let inputs =
         LRUHash.replace map 0 20 ;
         LRUHash.replace map 3 10 ;
         map )
-    , [(0, 20); (2, 10); (3, 10)] )
+    , [(3, 10); (0, 20); (2, 10)] )
+  ; ( "remove"
+    , (fun () ->
+        let map = LRUHash.create ~initial_size:5 ~max_size:3 in
+        LRUHash.replace map 0 10 ;
+        LRUHash.replace map 1 10 ;
+        LRUHash.replace map 2 10 ;
+        LRUHash.remove map 1 ;
+        LRUHash.replace map 3 10 ;
+        map )
+    , [(3, 10); (2, 10); (0, 10)] )
   ; ( "clear"
     , (fun () ->
         let map = LRUHash.create ~initial_size:5 ~max_size:3 in
@@ -50,11 +68,6 @@ let inputs =
 
 
 let tests =
-  let compare (k1, v1) (k2, v2) =
-    let c = k1 - k2 in
-    if c <> 0 then c else v1 - v2
-  in
   "LRUHashtble"
   >::: List.map inputs ~f:(fun (name, input, expected) ->
-           name
-           >:: fun _ -> assert_equal (input () |> LRUHash.bindings |> List.sort ~compare) expected )
+           name >:: fun _ -> assert_equal (input () |> LRUHash.bindings) expected )