[pp] hv box for printing collections

Summary: Long lists will be broken into lines rather than stretch out on a single line.

Reviewed By: jvillard

Differential Revision: D5424323

fbshipit-source-id: 115f16a

infer/src/base/PrettyPrintable.ml

@@ -35,11 +35,15 @@ module type PPMap = sig
 end
 
 let pp_collection ~pp_item fmt c =
-  let pp_collection fmt c =
-    let pp_sep fmt () = F.fprintf fmt ", " in
-    F.pp_print_list ~pp_sep pp_item fmt c
+  let rec pp_list fmt = function
+    | []
+     -> ()
+    | [item]
+     -> F.fprintf fmt "@[<h>%a@] " pp_item item
+    | item :: items
+     -> F.fprintf fmt "@[<h>%a,@]@ " pp_item item ; pp_list fmt items
   in
-  F.fprintf fmt "{ %a }" pp_collection c
+  F.fprintf fmt "@[<hv 2>{ %a}@]" pp_list c
 
 module MakePPSet (Ord : PrintableOrderedType) = struct
   include Caml.Set.Make (Ord)

infer/src/unit/BoundedCallTreeTests.ml

@@ -73,7 +73,7 @@ let tests =
   let test_list_from_baz =
     [ ( "ignore_procs_unrelated_to_trace"
       , [make_call ~procname:f_proc_name None []; (* means f() *)
-        invariant "{  }"] ) ]
+        invariant "{ }"] ) ]
     |> TestInterpreter.create_tests ~test_pname:caller_baz_name extras ~initial
   in
   let test_list_multiple_traces_from_foo =

infer/src/unit/TaintTests.ml

@@ -114,7 +114,7 @@ let tests =
   let read_field_to_id lhs_id_str root_str fld_str =
     make_load_fld ~rhs_typ:(Typ.mk Tvoid) lhs_id_str fld_str (Exp.Var (ident_of_str root_str))
   in
-  let assert_empty = invariant "{  }" in
+  let assert_empty = invariant "{ }" in
   (* hack: register an empty analyze_ondemand to prevent a crash because the callback is unset *)
   let analyze_ondemand summary _ = summary in
   let get_proc_desc _ = None in
@@ -137,8 +137,8 @@ let tests =
         ; read_field_to_id "read_id" "base_id" "f"
         ; var_assign_id "var" "read_id"
         ; invariant
-            "{ base_id$0.f => (SOURCE -> ?), ret_id$0 => (SOURCE -> ?), &var => (SOURCE -> ?) }" ]
-      )
+            "{ base_id$0.f => (SOURCE -> ?),\n  ret_id$0 => (SOURCE -> ?),\n  &var => (SOURCE -> ?) }"
+        ] )
     ; ( "source flows to var then cleared"
       , [ assign_to_source "ret_id"
         ; var_assign_id "var" "ret_id"
@@ -184,7 +184,7 @@ let tests =
         ; read_field_to_id "read_id" "var_id" "f"
         ; call_sink "read_id"
         ; invariant
-            "{ base_id$0.f => (SOURCE -> ?), ret_id$0 => (SOURCE -> ?), &var.f* => (SOURCE -> SINK) }"
+            "{ base_id$0.f => (SOURCE -> ?),\n  ret_id$0 => (SOURCE -> ?),\n  &var.f* => (SOURCE -> SINK) }"
         ] )
     ; ( "source -> sink via cast"
       , [ assign_to_source "ret_id"

infer/src/unit/addressTakenTests.ml

@@ -14,7 +14,7 @@ module TestInterpreter = AnalyzerTester.Make (ProcCfg.Exceptional) (AddressTaken
 let tests =
   let open OUnit2 in
   let open AnalyzerTester.StructuredSil in
-  let assert_empty = invariant "{  }" in
+  let assert_empty = invariant "{ }" in
   let int_typ = Typ.mk (Tint IInt) in
   let int_ptr_typ = Typ.mk (Tptr (int_typ, Pk_pointer)) in
   let fun_ptr_typ = Typ.mk (Tptr (Typ.mk (Tfun false), Pk_pointer)) in

infer/src/unit/copyPropagationTests.ml

@@ -15,7 +15,7 @@ module TestInterpreter =
 let tests =
   let open OUnit2 in
   let open AnalyzerTester.StructuredSil in
-  let assert_empty = invariant "{  }" in
+  let assert_empty = invariant "{ }" in
   let test_list =
     [ ("id_load_id_no_gen", [id_assign_id "b" "a"; (* means b = *a *)
                             assert_empty])

infer/src/unit/livenessTests.ml

@@ -15,7 +15,7 @@ module TestInterpreter =
 let tests =
   let open OUnit2 in
   let open AnalyzerTester.StructuredSil in
-  let assert_empty = invariant "{  }" in
+  let assert_empty = invariant "{ }" in
   let fun_ptr_typ = Typ.mk (Tptr (Typ.mk (Tfun false), Pk_pointer)) in
   let closure_exp captured_pvars =
     let mk_captured_var str = (Exp.Var (ident_of_str str), pvar_of_str str, dummy_typ) in