unikernel/duniverse/ppx_custom_printf/test/test.ml

@@ -0,0 +1,162 @@
+let sprintf = Printf.sprintf
+let ksprintf = Printf.ksprintf
+
+open Ppx_sexp_conv_lib.Conv
+
+module Time : sig
+  type t
+
+  val now : unit -> t
+  val to_string : t -> string
+  val to_string_sec : t -> string
+  val to_string_abs : t -> string
+end = struct
+  type t = string
+
+  let now () = "Time.now ()"
+  let to_string t = "[Time.to_string (" ^ t ^ ")]"
+  let to_string_sec t = "[Time.to_string_sec (" ^ t ^ ")]"
+  let to_string_abs t = "[Time.to_string_abs (" ^ t ^ ")]"
+end
+
+module Zone : sig
+  type t
+
+  val local : t
+  val to_string : t -> string
+end = struct
+  type t = string
+
+  let local = "Zone.local"
+  let to_string t = "[Zone.to_string " ^ t ^ "]"
+end
+
+let%test _ =
+  sprintf !"The time is %{Time} and the timezone is %{Zone}.\n" (Time.now ()) Zone.local
+  = "The time is [Time.to_string (Time.now ())] and the timezone is [Zone.to_string \
+     Zone.local].\n"
+;;
+
+(* check that custom directives with nothing in between are properly translated *)
+let%test _ = sprintf !"%{sexp:int}%{sexp:int}%{sexp:int}%{sexp:int}" 1 2 3 4 = "1234"
+
+(* check that things works well when the conversion function take optional arguments *)
+let%test _ =
+  let to_string ?foo:_ x = string_of_int x in
+  sprintf !"%{to_string}\n" 42 = "42\n"
+;;
+
+(* check the X#y kinds of format and that arguments are not
+   reversed somehow *)
+let%test _ =
+  let now = Time.now () in
+  sprintf !"%{Time}, %{Time#sec}, %{Time.to_string_abs}\n%!" now now now
+  = "[Time.to_string (Time.now ())], [Time.to_string_sec (Time.now ())], \
+     [Time.to_string_abs (Time.now ())]\n"
+;;
+
+(* same as above, with empty module paths *)
+let%test _ =
+  let open Time in
+  let now = now () in
+  sprintf !"%{}, %{#sec}, %{to_string_abs}\n%!" now now now
+  = "[Time.to_string (Time.now ())], [Time.to_string_sec (Time.now ())], \
+     [Time.to_string_abs (Time.now ())]\n"
+;;
+
+(* testing what happens if the expression to the left of the format string
+   is a bit complicated *)
+let%test _ =
+  let s = ksprintf (fun s -> s ^ " foo") !"%{Time} bar" (Time.now ()) in
+  s = "[Time.to_string (Time.now ())] bar foo"
+;;
+
+(* checking sexp: format *)
+let%test "sexp conversion" =
+  sprintf !"The pair is: %{sexp:int * string}" (4, "asdf") = "The pair is: (4 asdf)"
+;;
+
+(* checking sexp#mach: format *)
+let%test "sexp#mach conversion" =
+  let module Ppx_sexp_conv_lib = struct
+    module Sexp = struct
+      include Ppx_sexp_conv_lib.Sexp
+
+      let to_string_mach sexp = to_string sexp ^ " (in machine format)"
+    end
+  end
+  in
+  sprintf !"The pair is: %{sexp#mach:int * string}" (4, "asdf")
+  = "The pair is: (4 asdf) (in machine format)"
+;;
+
+(* checking tricky formats *)
+let%test _ = sprintf !"%d %%{foo" 3 = "3 %{foo"
+
+let%test _ =
+  sprintf !"%d %%{%{Time}" 3 (Time.now ()) = "3 %{[Time.to_string (Time.now ())]"
+;;
+
+(* checking that when we eta expand, we do not change side effects *)
+let%test _ =
+  let side_effect1_happened = ref false in
+  let side_effect2_happened = ref false in
+  let _f : Zone.t -> string =
+    (side_effect1_happened := true;
+     sprintf)
+      !"%{Time} %{Zone}"
+      (side_effect2_happened := true;
+       Time.now ())
+  in
+  !side_effect1_happened && !side_effect2_happened
+;;
+
+let%test _ =
+  let to_string () = "plop" in
+  sprintf !"%{  }" () = "plop"
+;;
+
+let%test_unit _ =
+  let f ~labeled_arg:() fmt = ksprintf (fun _ -> ()) fmt in
+  (* Check that it compiles with the labeled argument applied both before and after the
+     format string *)
+  f ~labeled_arg:() !"hello";
+  f !"hello" ~labeled_arg:()
+;;
+
+let%test_unit _ =
+  let after1 = Some () in
+  let f ~before:() fmt = ksprintf (fun _ ?after1:_ () ~after2:() -> ()) fmt in
+  f ~before:() ?after1 !"hello" () ~after2:();
+  f ~before:() !"hello" ?after1 () ~after2:();
+  f !"hello" ~before:() ?after1 () ~after2:();
+  f !"hello" ?after1 ~before:() () ~after2:()
+;;
+
+let%test_unit _ =
+  let f ~label:() fmt = ksprintf (fun _ -> ()) fmt in
+  let r = ref 0 in
+  let g = f !"%{Time}" ~label:(incr r) in
+  g (Time.now ());
+  g (Time.now ());
+  assert (!r = 1)
+;;
+
+let%test "format subst" = sprintf !"%(%d%)" "[%d]" 1 = "[1]"
+let first_class_format1 = !"u = %{sexp:int * int}"
+let first_class_format2 = !"t = %{Time}"
+
+let first_class_format3 =
+  first_class_format1 ^^ ", " ^^ first_class_format2 ^^ !", v = %{sexp:int}"
+;;
+
+let%test _ = sprintf first_class_format1 (0, 42) = "u = (0 42)"
+
+let%test _ =
+  sprintf first_class_format2 (Time.now ()) = "t = [Time.to_string (Time.now ())]"
+;;
+
+let%test _ =
+  sprintf first_class_format3 (0, 42) (Time.now ()) 10
+  = "u = (0 42), t = [Time.to_string (Time.now ())], v = 10"
+;;