Merge pull request #566 from ocaml-multicore/util-pp-printers

Use `QCheck.Print` combinators in `Util.Pp` printers for consistency

Author: jmid

CHANGES.md

@@ -2,6 +2,8 @@
 
 ## NEXT RELEASE
 
+- #566: Use `QCheck.Print` combinators in `Util.Pp` too for consistency,
+        e.g., to avoid that `STM` argument and result printer outputs differ.
 - #562: Fix the `int32` and `int64` printers in both `Lin` and `STM` to add
         missing `l` and `L` suffixes on literals.
 - #560: Change `Lin.{constructible,deconstructible}` from an empty variant type

lib/util.ml

@@ -158,14 +158,14 @@ module Pp = struct
 
   let pp_exn = of_show Printexc.to_string
   let pp_unit _ fmt () = pp_print_string fmt "()"
-  let pp_bool _ fmt b = fprintf fmt "%B" b
-  let pp_int par fmt i = fprintf fmt (if par && i < 0 then "(%d)" else "%d") i
-  let pp_int32 par fmt i = fprintf fmt (if par && i < 0l then "(%ldl)" else "%ldl") i
-  let pp_int64 par fmt i = fprintf fmt (if par && i < 0L then "(%LdL)" else "%LdL") i
-  let pp_float par fmt f = fprintf fmt (if par && f < 0.0 then "(%F)" else "%F") f
-  let pp_char _ fmt c = fprintf fmt "%C" c
-  let pp_string _ fmt s = fprintf fmt "%S" s
-  let pp_bytes _ fmt s = fprintf fmt "%S" (Bytes.to_string s)
+  let pp_bool _ fmt b = fprintf fmt "%s" (QCheck.Print.bool b)
+  let pp_int par fmt i = fprintf fmt (if par && i < 0 then "(%s)" else "%s") (QCheck.Print.int i)
+  let pp_int32 par fmt i = fprintf fmt (if par && i < 0l then "(%s)" else "%s") (QCheck.Print.int32 i)
+  let pp_int64 par fmt i = fprintf fmt (if par && i < 0L then "(%s)" else "%s") (QCheck.Print.int64 i)
+  let pp_float par fmt f = fprintf fmt (if par && f < 0.0 then "(%s)" else "%s") (QCheck.Print.float f)
+  let pp_char _ fmt c = fprintf fmt "%s" (QCheck.Print.char c)
+  let pp_string _ fmt s = fprintf fmt "%s" (QCheck.Print.string s)
+  let pp_bytes _ fmt s = fprintf fmt "%s" (QCheck.Print.bytes s)
 
   let pp_option (pp_s : 'a t) par fmt o =
     match o with

test/util_pp.expected

@@ -14,7 +14,13 @@ Test of pp_int64 (negative):
 -12345L
 
 Test of pp_float (infinity):
-infinity
+inf
+
+Test of pp_float (neg_infinity):
+-inf
+
+Test of pp_float (nan):
+nan
 
 Test of pp_float (pi):
 3.14159265359

test/util_pp.ml

@@ -27,6 +27,9 @@ let _ =
   pr "pp_int32 (positive)" pp_int32 12345l;
   pr "pp_int64 (negative)" pp_int64 (-12345L);
   pr "pp_float (infinity)" pp_float Float.infinity;
+  pr "pp_float (neg_infinity)" pp_float Float.neg_infinity;
+  pr "pp_float (nan)" pp_float nan;
+(*pr "pp_float (-. nan)" pp_float (-. nan);*)
   pr "pp_float (pi)" pp_float Float.pi;
   pr "pp_char (printable)" pp_char 'a';
   pr "pp_char (unprintable)" pp_char '\000';

test/util_pp_trunc150.expected

@@ -14,7 +14,13 @@ Test of pp_int64 (negative):
 -12345L
 
 Test of pp_float (infinity):
-infinity
+inf
+
+Test of pp_float (neg_infinity):
+-inf
+
+Test of pp_float (nan):
+nan
 
 Test of pp_float (pi):
 3.14159265359

test/util_pp_trunc5.expected

@@ -14,7 +14,13 @@ Test of pp_int64 (negative):
 -12345L
 
 Test of pp_float (infinity):
-infinity
+inf
+
+Test of pp_float (neg_infinity):
+-inf
+
+Test of pp_float (nan):
+nan
 
 Test of pp_float (pi):
 3.14159265359

test/util_pp_trunc79.expected

@@ -14,7 +14,13 @@ Test of pp_int64 (negative):
 -12345L
 
 Test of pp_float (infinity):
-infinity
+inf
+
+Test of pp_float (neg_infinity):
+-inf
+
+Test of pp_float (nan):
+nan
 
 Test of pp_float (pi):
 3.14159265359