Merge pull request #676 from rgrinberg/fix-expect-tests-4.02.3

Fix expect tests 4.02.3

src/import.ml

@@ -138,6 +138,29 @@ module Fmt = struct
   let nl = Format.pp_print_newline
 
   let prefix f g ppf x = f ppf; g ppf x
+
+  let ocaml_list pp fmt = function
+    | [] -> Format.pp_print_string fmt "[]"
+    | l ->
+      Format.fprintf fmt "@[<hv>[ %a@ ]@]"
+        (list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
+           pp) l
+
+  let quoted fmt = Format.fprintf fmt "%S"
+
+  let const
+    : 'a t -> 'a -> unit t
+    = fun pp a' fmt () -> pp fmt a'
+
+  let record fmt = function
+    | [] -> Format.pp_print_string fmt "{}"
+    | xs ->
+      let pp fmt (field, pp) =
+        Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
+          field pp () in
+      let pp_sep fmt () = Format.fprintf fmt "@,; " in
+      Format.fprintf fmt "@[<hv>{ %a@ }@]"
+        (Format.pp_print_list ~pp_sep pp) xs
 end
 
 (* This is ugly *)

src/meta.ml

@@ -102,12 +102,34 @@ module Parse = struct
       error lb "'package' or variable name expected"
 end
 
+let pp_action fmt = function
+  | Set -> Format.pp_print_string fmt "Set"
+  | Add -> Format.pp_print_string fmt "Add"
+
+let pp_predicate fmt = function
+  | Pos s -> Format.fprintf fmt "%S" ("+" ^ s)
+  | Neg s -> Format.fprintf fmt "%S" ("-" ^ s)
+
+let pp_rule fmt (t : rule) =
+  Fmt.record fmt
+    [ "var", (Fmt.const Fmt.quoted t.var)
+    ; "predicates", (Fmt.const (Fmt.ocaml_list pp_predicate) t.predicates)
+    ; "action", (Fmt.const pp_action t.action)
+    ; "value", (Fmt.const Fmt.quoted t.value)
+    ]
+
 module Simplified = struct
   module Rules = struct
     type t =
       { set_rules : rule list
       ; add_rules : rule list
       }
+
+    let pp fmt t =
+      Fmt.record fmt
+        [ "set_rules", Fmt.const (Fmt.ocaml_list pp_rule) t.set_rules
+        ; "add_rules", Fmt.const (Fmt.ocaml_list pp_rule) t.add_rules
+        ]
   end
 
   type t =
@@ -115,6 +137,13 @@ module Simplified = struct
     ; vars : Rules.t String_map.t
     ; subs : t list
     }
+
+  let rec pp fmt t =
+    Fmt.record fmt
+      [ "name", Fmt.const Fmt.quoted t.name
+      ; "vars", Fmt.const (String_map.pp Rules.pp) t.vars
+      ; "subs", Fmt.const (Fmt.ocaml_list pp) t.subs
+      ]
 end
 
 let rec simplify t =

src/meta.mli

@@ -38,6 +38,8 @@ module Simplified : sig
     ; vars : Rules.t String_map.t
     ; subs : t list
     }
+
+  val pp : Format.formatter -> t -> unit
 end
 
 val load : fn:string -> name:string -> Simplified.t

test/unit-tests/tests.mlt

@@ -49,21 +49,30 @@ Findlib.Package.requires pkg;;
    +-----------------------------------------------------------------+ *)
 
 open Meta
+#install_printer Simplified.pp;;
 
 let meta =
   Meta.load ~name:"foo" ~fn:"test/unit-tests/findlib-db/foo/META"
 
 [%%expect{|
 val meta : Jbuilder.Meta.Simplified.t =
-  {Jbuilder.Meta.Simplified.name = "foo";
-   vars =
-    (requires =
-      {Jbuilder.Meta.Simplified.Rules.set_rules =
-        [{Jbuilder__Meta.var = "requires"; predicates = [];
-          action = Jbuilder__Meta.Set; value = "bar"};
-         {Jbuilder__Meta.var = "requires";
-          predicates = [Jbuilder__Meta.Pos "ppx_driver"];
-          action = Jbuilder__Meta.Set; value = "baz"}];
-       add_rules = []});
-   subs = []}
+  { name = "foo"
+  ; vars =
+     (requires =
+       { set_rules =
+          [ { var = "requires"
+            ; predicates = []
+            ; action = Set
+            ; value = "bar"
+            }
+          ; { var = "requires"
+            ; predicates = [ "+ppx_driver" ]
+            ; action = Set
+            ; value = "baz"
+            }
+          ]
+       ; add_rules = []
+       })
+  ; subs = []
+  }
 |}]