1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
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"
;;
|
