unikernel/duniverse/ppx_custom_printf/.gitignore

@@ -0,0 +1,5 @@
+_build
+*.install
+*.merlin
+_opam
+

unikernel/duniverse/ppx_custom_printf/.ocamlformat

@@ -0,0 +1 @@
+profile=janestreet

unikernel/duniverse/ppx_custom_printf/CHANGES.md

@@ -0,0 +1,23 @@
+## v0.11
+
+Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver,
+ppx\_metaquot, ppx\_traverse and ppx\_type\_conv.
+
+## 113.43.00
+
+- use the new context-free API
+
+## 113.24.00
+
+- OCaml makes no distinctions between "foo" and
+  `{whatever|foo|whatever}`. The delimiter choice is simply left to the
+  user.
+
+  Do the same in our ppx rewriters: i.e. wherever we accept "foo", also
+  accept `{whatever|foo|whatever}`.
+
+- Fix missing location in errors for broken custom printf example like:
+
+      printf !"%{sexp: int" 3;;
+
+- Update to follow `Ppx_core` evolution.

unikernel/duniverse/ppx_custom_printf/CONTRIBUTING.md

@@ -0,0 +1,67 @@
+This repository contains open source software that is developed and
+maintained by [Jane Street][js].
+
+Contributions to this project are welcome and should be submitted via
+GitHub pull requests.
+
+Signing contributions
+---------------------
+
+We require that you sign your contributions. Your signature certifies
+that you wrote the patch or otherwise have the right to pass it on as
+an open-source patch. The rules are pretty simple: if you can certify
+the below (from [developercertificate.org][dco]):
+
+```
+Developer Certificate of Origin
+Version 1.1
+
+Copyright (C) 2004, 2006 The Linux Foundation and its contributors.
+1 Letterman Drive
+Suite D4700
+San Francisco, CA, 94129
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+
+Developer's Certificate of Origin 1.1
+
+By making a contribution to this project, I certify that:
+
+(a) The contribution was created in whole or in part by me and I
+    have the right to submit it under the open source license
+    indicated in the file; or
+
+(b) The contribution is based upon previous work that, to the best
+    of my knowledge, is covered under an appropriate open source
+    license and I have the right under that license to submit that
+    work with modifications, whether created in whole or in part
+    by me, under the same open source license (unless I am
+    permitted to submit under a different license), as indicated
+    in the file; or
+
+(c) The contribution was provided directly to me by some other
+    person who certified (a), (b) or (c) and I have not modified
+    it.
+
+(d) I understand and agree that this project and the contribution
+    are public and that a record of the contribution (including all
+    personal information I submit with it, including my sign-off) is
+    maintained indefinitely and may be redistributed consistent with
+    this project or the open source license(s) involved.
+```
+
+Then you just add a line to every git commit message:
+
+```
+Signed-off-by: Joe Smith <joe.smith@email.com>
+```
+
+Use your real name (sorry, no pseudonyms or anonymous contributions.)
+
+If you set your `user.name` and `user.email` git configs, you can sign
+your commit automatically with git commit -s.
+
+[dco]: http://developercertificate.org/
+[js]: https://opensource.janestreet.com/

unikernel/duniverse/ppx_custom_printf/LICENSE.md

@@ -0,0 +1,21 @@
+The MIT License
+
+Copyright (c) 2015--2024 Jane Street Group, LLC <opensource-contacts@janestreet.com>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

unikernel/duniverse/ppx_custom_printf/Makefile

@@ -0,0 +1,17 @@
+INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
+
+default:
+	dune build
+
+install:
+	dune install $(INSTALL_ARGS)
+
+uninstall:
+	dune uninstall $(INSTALL_ARGS)
+
+reinstall: uninstall install
+
+clean:
+	dune clean
+
+.PHONY: default install uninstall reinstall clean

unikernel/duniverse/ppx_custom_printf/README.md

@@ -0,0 +1,93 @@
+ppx_custom_printf
+=================
+
+Extensions to printf-style format-strings for user-defined string conversion.
+
+`ppx_custom_printf` is a ppx rewriter that allows the use of
+user-defined string conversion functions in format strings (that is,
+strings passed to printf, sprintf, etc.).
+
+No new syntax is introduced.  Instead a previously ill-typed use of
+the `!` operator is re-purposed.
+
+Basic Usage
+-----------
+
+The basic usage is as follows:
+
+```ocaml
+printf !"The time is %{Time} and the timezone is %{Time.Zone}."
+  time zone
+```
+
+The ppx rewriter will turn the `!`-string into a format of type
+`(Time.t -> Time.Zone.t -> unit, unit, string) format`. This is done
+by embedding the `Time.to_string` and `Time.Zone.to_string` functions
+into the format, using the low-level format mechanism of the stdlib.
+
+In general, specifiers like `%{<Module-path>}` produce a call to
+`Module-path.to_string`.  The module path can even be empty, in which
+case the generated code calls `to_string`.
+
+Note that you have to prepend the format string with a `!`, so that
+the ppx rewriter knows to operate on it.
+
+Sexps
+-----
+
+The syntax `%{sexp:<type>}` is also supported.  For example:
+
+```ocaml
+printf !"The time is %{sexp:Time.t}." time
+```
+
+The `time` argument will be turned into a string using:
+
+```ocaml
+fun x -> Sexplib.Sexp.to_string_hum ([%sexp_of: Time.t] x)
+```
+
+This supports arbitrary type expressions.
+
+You can use `Sexplib.Sexp.to_string_mach` instead of
+`Sexplib.Sexp.to_string_hum` by using `%{sexp#mach:<type>}`
+
+Using functions other than `M.to_string`
+----------------------------------------
+
+The format specifier `%{<Module-path>.<lowercase_identifier>}`
+corresponds to that function.  So, for example:
+
+```ocaml
+printf !"The date is %{Core.Date.to_string_iso8601_basic}" date
+```
+
+will turn `date` to a string using the following code:
+
+```ocaml
+fun x -> Core.Date.to_string_iso8601_basic x
+```
+
+Further, the format specifier
+`%{<Module-path>#<lowercase_identifier>}` corresponds to the function
+`<Module_path>.to_string_<lowercase_identifier>`.  So, for example:
+
+```ocaml
+printf !"The date is %{Core.Date#american}" date
+```
+
+will turn `date` to a string using:
+
+```ocaml
+fun x -> Core.Date.to_string_american x
+```
+
+Subformats disallowed
+---------------------
+
+In a regular format string, you can use format specifiers of the form
+`%{<spec>%}` and `%(<spec>%)` where `<spec>` is another format
+specifier.
+
+Using these specifiers is disallowed in format strings that are
+processed with custom-printf.

unikernel/duniverse/ppx_custom_printf/dune-project

@@ -0,0 +1 @@
+(lang dune 3.11)

unikernel/duniverse/ppx_custom_printf/ppx_custom_printf.opam

@@ -0,0 +1,24 @@
+opam-version: "2.0"
+version: "v0.17.0"
+maintainer: "Jane Street developers"
+authors: ["Jane Street Group, LLC"]
+homepage: "https://github.com/janestreet/ppx_custom_printf"
+bug-reports: "https://github.com/janestreet/ppx_custom_printf/issues"
+dev-repo: "git+https://github.com/janestreet/ppx_custom_printf.git"
+doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_custom_printf/index.html"
+license: "MIT"
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+]
+depends: [
+  "ocaml"         {>= "5.1.0"}
+  "base"          {>= "v0.17" & < "v0.18"}
+  "ppx_sexp_conv" {>= "v0.17" & < "v0.18"}
+  "dune"          {>= "3.11.0"}
+  "ppxlib"        {>= "0.28.0"}
+]
+available: arch != "arm32" & arch != "x86_32"
+synopsis: "Printf-style format-strings for user-defined string conversion"
+description: "
+Part of the Jane Street's PPX rewriters collection.
+"

unikernel/duniverse/ppx_custom_printf/src/dune

@@ -0,0 +1,15 @@
+(library
+ (name ppx_custom_printf)
+ (public_name ppx_custom_printf)
+ (kind ppx_rewriter)
+ (libraries compiler-libs.common base ppxlib ppx_sexp_conv.expander
+   ppxlib.metaquot_lifters)
+ (preprocess
+  (pps ppxlib.metaquot ppxlib.traverse)))
+
+(rule
+ (targets format_lifter.ml)
+ (deps
+  (:first_dep gen/gen.bc))
+ (action
+  (run %{first_dep} -o format_lifter.ml)))

unikernel/duniverse/ppx_custom_printf/src/gen/dune

@@ -0,0 +1,5 @@
+(executables
+ (modes byte exe)
+ (names gen)
+ (libraries str compiler-libs.common compiler-libs.toplevel)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppx_custom_printf/src/gen/gen.ml

@@ -0,0 +1,57 @@
+open StdLabels
+open Format
+
+let lsplit2 s ~on =
+  match String.index s on with
+  | exception Not_found -> None
+  | i ->
+    Some
+      ( String.sub s ~pos:0 ~len:i
+      , String.sub s ~pos:(i + 1) ~len:(String.length s - i - 1) )
+;;
+
+let () =
+  let oc =
+    match Sys.argv with
+    | [| _; "-o"; fn |] -> open_out_bin fn
+    | _ -> failwith "bad command line arguments"
+  in
+  try
+    let buf = Buffer.create 512 in
+    let pp = formatter_of_buffer buf in
+    pp_set_margin pp max_int;
+    (* so we can parse line by line below *)
+    Toploop.initialize_toplevel_env ();
+    assert (
+      Lexing.from_string "include CamlinternalFormatBasics;;"
+      |> !Toploop.parse_toplevel_phrase
+      |> Toploop.execute_phrase true pp);
+    let types =
+      Buffer.contents buf
+      |> Str.split (Str.regexp "\n")
+      |> List.fold_left ~init:(false, []) ~f:(fun (in_type_group, acc) s ->
+           match lsplit2 s ~on:' ' with
+           | Some ("type", s) -> true, s :: acc
+           | Some ("and", s) when in_type_group -> true, s :: acc
+           | _ -> false, acc)
+      |> snd
+      |> List.rev
+    in
+    let s =
+      String.concat
+        ~sep:"\n"
+        (match types with
+         | [] -> []
+         | x :: l ->
+           (("type " ^ x) :: List.map l ~f:(( ^ ) "and "))
+           @ [ "[@@deriving traverse_lift]" ])
+    in
+    let intf = Parse.interface (Lexing.from_string s) in
+    let ppf = formatter_of_out_channel oc in
+    fprintf ppf "%a@." Pprintast.signature intf;
+    close_out oc
+  with
+  | exn ->
+    Location.report_exception Format.err_formatter exn;
+    exit 2
+;;

unikernel/duniverse/ppx_custom_printf/src/ppx_custom_printf.ml

@@ -0,0 +1,295 @@
+open Base
+open Ppxlib
+open Ast_builder.Default
+
+(* returns the index of the conversion spec (unless the end of string is reached) *)
+let rec skip_over_format_flags fmt i =
+  if i >= String.length fmt
+  then `Eoi
+  else (
+    match fmt.[i] with
+    | '*' | '#' | '-' | ' ' | '+' | '_' | '0' .. '9' | '.' ->
+      skip_over_format_flags fmt (i + 1)
+    | _ -> `Ok i)
+;;
+
+(* doesn't check to make sure the format string is well-formed *)
+(* Formats with subformats are skipped for the following reasons:
+
+   One is that they are hard to understand and not often used.
+
+   Another is that subformats like "%(%{Module}%)" won't work, since it
+   is impossible to produce a format of type [(Module.t -> 'a,...) format].
+*)
+let has_subformats (fmt : string) =
+  let lim = String.length fmt - 1 in
+  let rec loop i =
+    if i > lim
+    then false
+    else if Char.equal fmt.[i] '%'
+    then (
+      match skip_over_format_flags fmt (i + 1) with
+      | `Eoi -> false
+      | `Ok i ->
+        (match fmt.[i] with
+         | '(' | ')' | '}' -> true
+         | _ -> loop (i + 1)))
+    else loop (i + 1)
+  in
+  loop 0
+;;
+
+(* returns a list of strings where even indexed elements are parts of the format string
+   that the preprocessor won't touch and odd indexed elements are the contents of %{...}
+   specifications. *)
+let explode ~loc (s : string) =
+  let len = String.length s in
+  (* for cases where we can't parse the string with custom format specifiers, consider
+     the string as a regular format string *)
+  let as_normal_format_string = [ s ] in
+  if has_subformats s
+  then as_normal_format_string
+  else (
+    let sub from to_ = String.sub s ~pos:from ~len:(to_ - from) in
+    let rec loop acc from to_ =
+      assert (List.length acc % 2 = 0);
+      if to_ >= len
+      then List.rev (if from >= len then acc else sub from len :: acc)
+      else if Char.( <> ) s.[to_] '%'
+      then loop acc from (to_ + 1)
+      else (
+        match skip_over_format_flags s (to_ + 1) with
+        | `Eoi -> as_normal_format_string
+        | `Ok i ->
+          (match s.[i] with
+           | '[' ->
+             (* Scan char sets are not allowed by printf-like functions. So we might as
+                well disallow them at compile-time so that we can reuse them as magic
+                format strings in this implementation. *)
+             Location.raise_errorf
+               ~loc
+               "ppx_custom_printf: scan char sets are not allowed in custom format \
+                strings"
+           | '{' ->
+             if to_ + 1 <> i
+             then
+               Location.raise_errorf
+                 ~loc
+                 "ppx_custom_printf: unexpected format flags before %%{} specification \
+                  in %S"
+                 s;
+             (match String.index_from s (to_ + 2) '}' with
+              | None -> as_normal_format_string
+              | Some i ->
+                let l = sub (to_ + 2) i :: sub from to_ :: acc in
+                loop l (i + 1) (i + 1))
+           | _ -> loop acc from (i + 1)))
+      (* skip the conversion spec *)
+    in
+    loop [] 0 0)
+;;
+
+let processed_format_string ~exploded_format_string =
+  let l =
+    let rec loop i l =
+      match l with
+      | s1 :: _s2 :: l -> s1 :: Printf.sprintf "%%%d[.]" i :: loop (i + 1) l
+      | [ s1 ] -> [ s1 ]
+      | [] -> []
+    in
+    loop 0 exploded_format_string
+  in
+  String.concat l ~sep:""
+;;
+
+let rec evens = function
+  | ([] | [ _ ]) as l -> l
+  | x :: _ :: l -> x :: evens l
+;;
+
+let odds = function
+  | [] -> []
+  | _ :: l -> evens l
+;;
+
+(* Returns a pair of:
+
+   - a format string, which is [s] where all custom format specifications have been
+     replaced by ["%" ^ string_of_int index ^ "[.]"] where [index] is the number of
+     the custom format specification, starting from 0. This string can be passed directly
+     to [CamlinternalFormat.fmt_ebb_of_string]
+   - an array of custom format specifications, in the order they appear in the original
+     string
+*)
+let extract_custom_format_specifications ~loc s =
+  let exploded_format_string = explode ~loc s in
+  let processed = processed_format_string ~exploded_format_string in
+  let custom_specs = Array.of_list (odds exploded_format_string) in
+  processed, custom_specs
+;;
+
+let gen_symbol = gen_symbol ~prefix:"_custom_printf"
+
+let is_space = function
+  | ' ' | '\t' | '\n' | '\r' -> true
+  | _ -> false
+;;
+
+let strip s =
+  let a = ref 0 in
+  let b = ref (String.length s - 1) in
+  while !a <= !b && is_space s.[!a] do
+    Int.incr a
+  done;
+  while !a <= !b && is_space s.[!b] do
+    Int.decr b
+  done;
+  if !a > !b then "" else String.sub s ~pos:!a ~len:(!b - !a + 1)
+;;
+
+let string_to_expr ~loc s =
+  let sexp_converter_opt =
+    match String.lsplit2 s ~on:':' with
+    | None -> None
+    | Some ("sexp", colon_suffix) ->
+      Some ([%expr Ppx_sexp_conv_lib.Sexp.to_string_hum], colon_suffix)
+    | Some (colon_prefix, colon_suffix) ->
+      (match String.chop_prefix colon_prefix ~prefix:"sexp#" with
+       | None -> None
+       | Some hash_suffix ->
+         Some
+           ( pexp_ident
+               ~loc
+               (Located.mk
+                  ~loc
+                  (Longident.parse ("Ppx_sexp_conv_lib.Sexp.to_string_" ^ hash_suffix)))
+           , colon_suffix ))
+  in
+  match sexp_converter_opt with
+  | Some (sexp_converter, unparsed_type) ->
+    let lexbuf = Lexing.from_string unparsed_type in
+    (* ~loc is the position of the string, not the position of the %{bla} group we're
+       looking at. The format strings don't contain location information, so we can't
+       actually find the proper positions. *)
+    lexbuf.lex_abs_pos <- loc.loc_start.pos_cnum;
+    lexbuf.lex_curr_p <- loc.loc_start;
+    let ty = Parse.core_type lexbuf in
+    let e = Ppx_sexp_conv_expander.Sexp_of.core_type ty in
+    let arg = gen_symbol () in
+    pexp_fun
+      ~loc
+      Nolabel
+      None
+      (pvar ~loc arg)
+      (eapply ~loc sexp_converter [ eapply ~loc e [ evar ~loc arg ] ])
+  | None ->
+    let fail loc =
+      Location.raise_errorf
+        ~loc
+        "ppx_custom_printf: string %S should be of the form <Module>, \
+         <Module>.<identifier>, <Module>#identifier, sexp:<type>, or sexp#mach:<type>"
+        s
+    in
+    let s, has_hash_suffix, to_string =
+      match String.lsplit2 s ~on:'#' with
+      | None -> s, false, "to_string"
+      | Some (s, hash_suffix) -> s, true, "to_string_" ^ hash_suffix
+    in
+    let to_string_id : Longident.t =
+      let s = strip s in
+      match s with
+      | "" -> Lident to_string
+      | _ ->
+        (match Longident.parse s with
+         | (Lident n | Ldot (_, n)) as id ->
+           if String.( <> ) n "" && Char.equal (Char.uppercase n.[0]) n.[0]
+           then Longident.Ldot (id, to_string)
+           else if not has_hash_suffix
+           then id
+           else fail loc
+         | _ -> fail loc)
+    in
+    let func = pexp_ident ~loc (Located.mk ~loc to_string_id) in
+    (* Eta-expand as the to_string function might take optional arguments *)
+    let arg = gen_symbol () in
+    pexp_fun ~loc Nolabel None (pvar ~loc arg) (eapply ~loc func [ evar ~loc arg ])
+;;
+
+class lifter ~loc ~custom_specs =
+  object (self)
+    inherit [expression] Format_lifter.lift as super
+    inherit Ppxlib_metaquot_lifters.expression_lifters loc
+
+    method! fmt
+      : type f0
+      f1
+      f2
+      f3
+      f4
+      f5.  (f0 -> expression)
+          -> (f1 -> expression)
+          -> (f2 -> expression)
+          -> (f3 -> expression)
+          -> (f4 -> expression)
+          -> (f5 -> expression)
+          -> (f0, f1, f2, f3, f4, f5) CamlinternalFormatBasics.fmt
+          -> expression =
+      fun f0 f1 f2 f3 f4 f5 fmt ->
+        let open CamlinternalFormatBasics in
+        match fmt with
+        (* Recognize the special form "%index[...whatever...]" *)
+        | Scan_char_set (Some idx, _, fmt)
+        (* [custom_specs] is empty if [explode] couldn't parse the string. In this case we
+           can have some scar char sets left. *)
+          when idx >= 0 && idx < Array.length custom_specs ->
+          let rest = self#fmt (fun _ -> assert false) f1 f2 f3 f4 f5 fmt in
+          let func = string_to_expr ~loc custom_specs.(idx) in
+          [%expr Custom (Custom_succ Custom_zero, (fun () -> [%e func]), [%e rest])]
+        | _ -> super#fmt f0 f1 f2 f3 f4 f5 fmt
+  end
+
+let expand_format_string ~loc fmt_string =
+  let processed_fmt_string, custom_specs =
+    extract_custom_format_specifications ~loc fmt_string
+  in
+  let (CamlinternalFormat.Fmt_EBB fmt) =
+    try CamlinternalFormat.fmt_ebb_of_string processed_fmt_string with
+    | e ->
+      Location.raise_errorf
+        ~loc
+        "%s"
+        (match e with
+         (* [fmt_ebb_of_string] normally raises [Failure] on invalid input *)
+         | Failure msg -> msg
+         | e -> Exn.to_string e)
+  in
+  let lifter = new lifter ~loc ~custom_specs in
+  let format6 = CamlinternalFormatBasics.Format (fmt, fmt_string) in
+  let phantom _ = assert false in
+  let e = lifter#format6 phantom phantom phantom phantom phantom phantom format6 in
+  [%expr ([%e e] : (_, _, _, _, _, _) CamlinternalFormatBasics.format6)]
+;;
+
+let expand e =
+  match e.pexp_desc with
+  | Pexp_apply
+      ( { pexp_attributes = ident_attrs; _ }
+      , [ ( Nolabel
+          , { pexp_desc = Pexp_constant (Pconst_string (str, _, _))
+            ; pexp_loc = loc
+            ; pexp_loc_stack = _
+            ; pexp_attributes = str_attrs
+            } )
+        ] ) ->
+    assert_no_attributes ident_attrs;
+    assert_no_attributes str_attrs;
+    let e' = expand_format_string ~loc str in
+    Some { e' with pexp_attributes = Merlin_helpers.hide_attribute :: e.pexp_attributes }
+  | _ -> None
+;;
+
+let () =
+  Driver.register_transformation
+    "custom_printf"
+    ~rules:[ Context_free.Rule.special_function "!" expand ]
+;;

unikernel/duniverse/ppx_custom_printf/test/dune

@@ -0,0 +1,9 @@
+(library
+ (name custom_printf_sample)
+ (libraries ppx_sexp_conv.runtime-lib)
+ (preprocess
+  (pps ppx_jane)))
+
+(alias
+ (name DEFAULT)
+ (deps test.ml.pp))

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"
+;;

unikernel/duniverse/ppx_custom_printf/test/test.mlt

@@ -0,0 +1,9 @@
+#print_column_numbers true
+
+let f () = !"%{sexp:nosuchtype}"
+
+[%%expect
+  {|
+Line _, characters 12-22:
+Error: Unbound value sexp_of_nosuchtype
+|}]