« back to all changes in this revision
Viewing changes to src_test/test_ppx_yojson.cppo.ml
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Package Import Robot
- Author(s): Ralf Treinen
- Date: 2018-03-28 21:56:16 UTC
- Revision ID: package-import@ubuntu.com-20180328215616-xzfykdl8ls43ydi6
Tags: upstream-3.1
Import upstream version 3.1
- files added:
- pkg
- src
- src_test
added
removed
src_test/test_ppx_yojson.cppo.ml
1
open OUnit2
2
3
type json = [%import: Yojson.Safe.json] [@@deriving show]
4
5
let show_error_or =
6
let module M = struct
7
type 'a error_or =
8
[%import: 'a Ppx_deriving_yojson_runtime.error_or] [@@deriving show]
9
end in
10
M.show_error_or
11
12
let assert_roundtrip pp_obj to_json of_json obj str =
13
let json = Yojson.Safe.from_string str in
14
let cleanup json = Yojson.Safe.(json |> to_string |> from_string) in
15
assert_equal ~printer:show_json json (cleanup (to_json obj));
16
assert_equal ~printer:(show_error_or pp_obj) (Result.Ok obj) (of_json json)
17
18
let assert_failure pp_obj of_json err str =
19
let json = Yojson.Safe.from_string str in
20
assert_equal ~printer:(show_error_or pp_obj) (Result.Error err) (of_json json)
21
22
type u = unit [@@deriving show, yojson]
23
type i1 = int [@@deriving show, yojson]
24
type i2 = int32 [@@deriving show, yojson]
25
type i3 = Int32.t [@@deriving show, yojson]
26
type i4 = int64 [@@deriving show, yojson]
27
type i5 = Int64.t [@@deriving show, yojson]
28
type i6 = nativeint [@@deriving show, yojson]
29
type i7 = Nativeint.t [@@deriving show, yojson]
30
type i8 = int64 [@encoding `string] [@@deriving show, yojson]
31
type i9 = nativeint [@encoding `string] [@@deriving show, yojson]
32
type f = float [@@deriving show, yojson]
33
type b = bool [@@deriving show, yojson]
34
type c = char [@@deriving show, yojson]
35
type s = string [@@deriving show, yojson]
36
type y = bytes [@@deriving show, yojson]
37
type xr = int ref [@@deriving show, yojson]
38
type xo = int option [@@deriving show, yojson]
39
type xl = int list [@@deriving show, yojson]
40
type xa = int array [@@deriving show, yojson]
41
type xt = int * int [@@deriving show, yojson]
42
43
type 'a p = 'a option
44
[@@deriving show, yojson]
45
type pv = [ `A | `B of int | `C of int * string ]
46
[@@deriving show, yojson]
47
type pva = [ `A ] and pvb = [ `B ]
48
[@@deriving show, yojson]
49
type 'a pvc = [ `C of 'a ]
50
[@@deriving show, yojson]
51
type pvd = [ pva | pvb | int pvc ]
52
[@@deriving show, yojson]
53
54
type v = A | B of int | C of int * string
55
[@@deriving show, yojson]
56
type r = { x : int; y : string }
57
[@@deriving show, yojson]
58
#if OCAML_VERSION >= (4, 03, 0)
59
type rv = RA | RB of int | RC of int * string | RD of { z : string }
60
[@@deriving show, yojson]
61
#endif
62
63
let test_unit ctxt =
64
assert_roundtrip pp_u u_to_yojson u_of_yojson
65
() "null"
66
67
let test_int ctxt =
68
assert_roundtrip pp_i1 i1_to_yojson i1_of_yojson
69
42 "42";
70
assert_roundtrip pp_i2 i2_to_yojson i2_of_yojson
71
42l "42";
72
assert_roundtrip pp_i3 i3_to_yojson i3_of_yojson
73
42l "42";
74
assert_roundtrip pp_i4 i4_to_yojson i4_of_yojson
75
42L "42";
76
assert_roundtrip pp_i5 i5_to_yojson i5_of_yojson
77
42L "42";
78
assert_roundtrip pp_i6 i6_to_yojson i6_of_yojson
79
42n "42";
80
assert_roundtrip pp_i7 i7_to_yojson i7_of_yojson
81
42n "42";
82
assert_roundtrip pp_i8 i8_to_yojson i8_of_yojson
83
42L "\"42\"";
84
assert_roundtrip pp_i9 i9_to_yojson i9_of_yojson
85
42n "\"42\""
86
87
let test_int_edge ctxt =
88
assert_roundtrip pp_i2 i2_to_yojson i2_of_yojson
89
0x7fffffffl "2147483647";
90
assert_roundtrip pp_i2 i2_to_yojson i2_of_yojson
91
(Int32.neg 0x80000000l) "-2147483648";
92
assert_roundtrip pp_i4 i4_to_yojson i4_of_yojson
93
0x7fffffffffffffffL "9223372036854775807";
94
assert_roundtrip pp_i4 i4_to_yojson i4_of_yojson
95
(Int64.neg 0x8000000000000000L) "-9223372036854775808"
96
97
let test_float ctxt =
98
assert_roundtrip pp_f f_to_yojson f_of_yojson
99
1.0 "1.0";
100
assert_equal ~printer:(show_error_or pp_f)
101
(Result.Ok 1.0)
102
(f_of_yojson (`Int 1))
103
104
let test_bool ctxt =
105
assert_roundtrip pp_b b_to_yojson b_of_yojson
106
true "true";
107
assert_roundtrip pp_b b_to_yojson b_of_yojson
108
false "false"
109
110
let test_char ctxt =
111
assert_roundtrip pp_c c_to_yojson c_of_yojson
112
'c' "\"c\"";
113
assert_failure pp_c c_of_yojson
114
"Test_ppx_yojson.c" "\"xxx\""
115
116
let test_string ctxt =
117
assert_roundtrip pp_s s_to_yojson s_of_yojson
118
"foo" "\"foo\"";
119
assert_roundtrip pp_y y_to_yojson y_of_yojson
120
(Bytes.of_string "foo") "\"foo\""
121
122
let test_ref ctxt =
123
assert_roundtrip pp_xr xr_to_yojson xr_of_yojson
124
(ref 42) "42"
125
126
let test_option ctxt =
127
assert_roundtrip pp_xo xo_to_yojson xo_of_yojson
128
(Some 42) "42";
129
assert_roundtrip pp_xo xo_to_yojson xo_of_yojson
130
None "null"
131
132
let test_list ctxt =
133
assert_roundtrip pp_xl xl_to_yojson xl_of_yojson
134
[] "[]";
135
assert_roundtrip pp_xl xl_to_yojson xl_of_yojson
136
[42; 43] "[42, 43]"
137
138
let test_array ctxt =
139
assert_roundtrip pp_xa xa_to_yojson xa_of_yojson
140
[||] "[]";
141
assert_roundtrip pp_xa xa_to_yojson xa_of_yojson
142
[|42; 43|] "[42, 43]"
143
144
let test_tuple ctxt =
145
assert_roundtrip pp_xt xt_to_yojson xt_of_yojson
146
(42, 43) "[42, 43]"
147
148
let test_ptyp ctxt =
149
assert_roundtrip (pp_p pp_i1) (p_to_yojson i1_to_yojson) (p_of_yojson i1_of_yojson)
150
(Some 42) "42";
151
assert_roundtrip (pp_p pp_i1) (p_to_yojson i1_to_yojson) (p_of_yojson i1_of_yojson)
152
None "null"
153
154
let test_pvar ctxt =
155
assert_roundtrip pp_pv pv_to_yojson pv_of_yojson
156
`A "[\"A\"]";
157
assert_roundtrip pp_pv pv_to_yojson pv_of_yojson
158
(`B 42) "[\"B\", 42]";
159
assert_roundtrip pp_pv pv_to_yojson pv_of_yojson
160
(`C (42, "foo")) "[\"C\", 42, \"foo\"]";
161
assert_roundtrip pp_pvd pvd_to_yojson pvd_of_yojson
162
`A "[\"A\"]";
163
assert_roundtrip pp_pvd pvd_to_yojson pvd_of_yojson
164
`B "[\"B\"]";
165
assert_roundtrip pp_pvd pvd_to_yojson pvd_of_yojson
166
(`C 1) "[\"C\", 1]";
167
assert_equal ~printer:(show_error_or pp_pvd)
168
(Result.Error "Test_ppx_yojson.pvd")
169
(pvd_of_yojson (`List [`String "D"]))
170
171
let test_var ctxt =
172
assert_roundtrip pp_v v_to_yojson v_of_yojson
173
A "[\"A\"]";
174
assert_roundtrip pp_v v_to_yojson v_of_yojson
175
(B 42) "[\"B\", 42]";
176
assert_roundtrip pp_v v_to_yojson v_of_yojson
177
(C (42, "foo")) "[\"C\", 42, \"foo\"]"
178
179
let test_rec ctxt =
180
assert_roundtrip pp_r r_to_yojson r_of_yojson
181
{x=42; y="foo"} "{\"x\":42,\"y\":\"foo\"}"
182
183
#if OCAML_VERSION >= (4, 03, 0)
184
let test_recvar ctxt =
185
assert_roundtrip pp_rv rv_to_yojson rv_of_yojson
186
RA "[\"RA\"]";
187
assert_roundtrip pp_rv rv_to_yojson rv_of_yojson
188
(RB 42) "[\"RB\", 42]";
189
assert_roundtrip pp_rv rv_to_yojson rv_of_yojson
190
(RC(42, "foo")) "[\"RC\", 42, \"foo\"]";
191
assert_roundtrip pp_rv rv_to_yojson rv_of_yojson
192
(RD{z="foo"}) "[\"RD\", {\"z\": \"foo\"}]"
193
#endif
194
195
type geo = {
196
lat : float [@key "Latitude"] ;
197
lon : float [@key "Longitude"] ;
198
}
199
[@@deriving yojson, show]
200
let test_key ctxt =
201
assert_roundtrip pp_geo geo_to_yojson geo_of_yojson
202
{lat=35.6895; lon=139.6917}
203
"{\"Latitude\":35.6895,\"Longitude\":139.6917}"
204
205
let test_field_err ctxt =
206
assert_equal ~printer:(show_error_or pp_geo)
207
(Result.Error "Test_ppx_yojson.geo.lat")
208
(geo_of_yojson (`Assoc ["Longitude", (`Float 42.0)]))
209
210
type id = Yojson.Safe.json [@@deriving yojson]
211
let test_id ctxt =
212
assert_roundtrip pp_json id_to_yojson id_of_yojson
213
(`Int 42) "42"
214
215
type custvar =
216
| Tea of string [@name "tea"]
217
| Vodka [@name "vodka"]
218
[@@deriving yojson, show]
219
let test_custvar ctxt =
220
assert_roundtrip pp_custvar custvar_to_yojson custvar_of_yojson
221
(Tea "oolong") "[\"tea\", \"oolong\"]";
222
assert_roundtrip pp_custvar custvar_to_yojson custvar_of_yojson
223
Vodka "[\"vodka\"]"
224
225
type custpvar =
226
[ `Tea of string [@name "tea"]
227
| `Beer of string * float [@name "beer"]
228
| `Vodka [@name "vodka"]
229
] [@@deriving yojson, show]
230
let test_custpvar ctxt =
231
assert_roundtrip pp_custpvar custpvar_to_yojson custpvar_of_yojson
232
(`Tea "earl_grey") "[\"tea\", \"earl_grey\"]";
233
assert_roundtrip pp_custpvar custpvar_to_yojson custpvar_of_yojson
234
(`Beer ("guinness", 3.3)) "[\"beer\", \"guinness\", 3.3]";
235
assert_roundtrip pp_custpvar custpvar_to_yojson custpvar_of_yojson
236
`Vodka "[\"vodka\"]"
237
238
type default = {
239
def : int [@default 42];
240
} [@@deriving yojson, show]
241
let test_default ctxt =
242
assert_roundtrip pp_default default_to_yojson default_of_yojson
243
{ def = 42 } "{}"
244
245
type bidi = int [@@deriving show, to_yojson, of_yojson]
246
let test_bidi ctxt =
247
assert_roundtrip pp_bidi bidi_to_yojson bidi_of_yojson
248
42 "42"
249
250
let test_shortcut ctxt =
251
assert_roundtrip pp_i1 [%to_yojson: int] [%of_yojson: int]
252
42 "42"
253
254
type nostrict = {
255
nostrict_field : int;
256
}
257
[@@deriving show, yojson { strict = false }]
258
let test_nostrict ctxt =
259
assert_equal ~printer:(show_error_or pp_nostrict)
260
(Result.Ok { nostrict_field = 42 })
261
(nostrict_of_yojson (`Assoc ["nostrict_field", (`Int 42);
262
"some_other_field", (`Int 43)]))
263
264
module Opentype :
265
sig
266
type 'a opentype = .. [@@deriving yojson]
267
type 'a opentype += A of 'a | B of string list [@@deriving yojson]
268
end =
269
struct
270
type 'a opentype = .. [@@deriving yojson]
271
type 'a opentype += A of 'a | B of string list [@@deriving yojson]
272
end
273
type 'a Opentype.opentype +=
274
| C of 'a Opentype.opentype * float
275
| A = Opentype.A
276
[@@deriving yojson]
277
let rec pp_opentype f fmt = function
278
A x -> Format.fprintf fmt "A(%s)" (f x)
279
| Opentype.B l -> Format.fprintf fmt "B(%s)" (String.concat ", " l)
280
| C (x, v) ->
281
Format.pp_print_string fmt "C(";
282
pp_opentype f fmt x;
283
Format.fprintf fmt ", %f)" v
284
| _ -> assert false
285
286
let test_opentype ctxt =
287
let pp_ot = pp_opentype string_of_int in
288
let to_yojson = Opentype.opentype_to_yojson i1_to_yojson in
289
let of_yojson = Opentype.opentype_of_yojson i1_of_yojson in
290
assert_roundtrip pp_ot to_yojson of_yojson
291
(Opentype.A 0) "[\"A\", 0]";
292
assert_roundtrip pp_ot to_yojson of_yojson
293
(Opentype.B ["one"; "two"]) "[\"B\", [ \"one\", \"two\"] ]";
294
assert_roundtrip pp_ot to_yojson of_yojson
295
(C (Opentype.A 42, 1.2)) "[\"C\", [\"A\", 42], 1.2]"
296
297
module Warnings = struct
298
299
module W34 = struct
300
301
[@@@ocaml.warning "@34"]
302
303
304
module M1 : sig type u [@@deriving yojson] end = struct
305
type internal = int list [@@deriving yojson]
306
type u = int list [@@deriving yojson]
307
end
308
(* the deriver for type [u] supposedly use the derivier of type
309
[internal]. Consider for instance the case where [u] is a map,
310
and internal is a list of bindings. *)
311
module M2 : sig type 'a u [@@deriving yojson] end = struct
312
type 'a internal = 'a list [@@deriving yojson]
313
type 'a u = 'a list [@@deriving yojson]
314
end
315
316
(* the deriver for type [u] supposedly use the derivier of type
317
[internal]. Consider for instance the case where [u] is a map,
318
and internal is a list of bindings. *)
319
(* module M1 : sig type 'a u [@@deriving yojson] end = struct *)
320
(* type 'a internal = .. [@@deriving yojson] (\* Triggers the warning *\) *)
321
(* type 'a internal += A of 'a | B of string list [@@deriving yojson] *)
322
(* type 'a u = 'a list [@@deriving yojson] *)
323
(* end *)
324
end
325
326
end
327
328
329
module TestShadowing = struct
330
module List = struct
331
let map () = ()
332
end
333
334
type t = int list [@@deriving yojson]
335
336
module Array = struct
337
let to_list () = ()
338
end
339
340
module Bytes = struct
341
let to_string () = ()
342
end
343
344
type v = bytes [@@deriving yojson]
345
346
end
347
348
349
module Test_recursive_polyvariant = struct
350
(* Regression test for
351
https://github.com/whitequark/ppx_deriving_yojson/issues/24 *)
352
type a = [ `B of string ]
353
[@@deriving of_yojson]
354
type b = [a | `C of b list]
355
[@@deriving of_yojson]
356
type c = [ a | b | `D of b list]
357
[@@deriving of_yojson]
358
let c_of_yojson yj : c Ppx_deriving_yojson_runtime.error_or = c_of_yojson yj
359
end
360
361
type 'a recursive1 = { lhs : string ; rhs : 'a }
362
and foo = unit recursive1
363
and bar = int recursive1
364
[@@deriving show, yojson]
365
366
let test_recursive ctxt =
367
assert_roundtrip (pp_recursive1 pp_i1)
368
(recursive1_to_yojson i1_to_yojson)
369
(recursive1_of_yojson i1_of_yojson)
370
{lhs="x"; rhs=42} "{\"lhs\":\"x\",\"rhs\":42}";
371
372
assert_roundtrip pp_foo foo_to_yojson foo_of_yojson
373
{lhs="x"; rhs=()} "{\"lhs\":\"x\",\"rhs\":null}" ;
374
375
assert_roundtrip pp_bar bar_to_yojson bar_of_yojson
376
{lhs="x"; rhs=42} "{\"lhs\":\"x\",\"rhs\":42}"
377
378
let test_int_redefined ctxt =
379
let module M = struct
380
type int = Break_things
381
382
let x = [%to_yojson: int] 1
383
end
384
in
385
let expected = `Int 1 in
386
assert_equal ~ctxt ~printer:show_json expected M.x
387
388
let suite = "Test ppx_yojson" >::: [
389
"test_unit" >:: test_unit;
390
"test_int" >:: test_int;
391
"test_int_edge" >:: test_int_edge;
392
"test_float" >:: test_float;
393
"test_bool" >:: test_bool;
394
"test_char" >:: test_char;
395
"test_string" >:: test_string;
396
"test_ref" >:: test_ref;
397
"test_option" >:: test_option;
398
"test_list" >:: test_list;
399
"test_array" >:: test_array;
400
"test_tuple" >:: test_tuple;
401
"test_ptyp" >:: test_ptyp;
402
"test_pvar" >:: test_pvar;
403
"test_var" >:: test_var;
404
"test_rec" >:: test_rec;
405
#if OCAML_VERSION >= (4, 03, 0)
406
"test_recvar" >:: test_recvar;
407
#endif
408
"test_key" >:: test_key;
409
"test_id" >:: test_id;
410
"test_custvar" >:: test_custvar;
411
"test_custpvar" >:: test_custpvar;
412
"test_field_err" >:: test_field_err;
413
"test_default" >:: test_default;
414
"test_bidi" >:: test_bidi;
415
"test_shortcut" >:: test_shortcut;
416
"test_nostrict" >:: test_nostrict;
417
"test_opentype" >:: test_opentype;
418
"test_recursive" >:: test_recursive;
419
"test_int_redefined" >:: test_int_redefined;
420
]
421
422
let _ =
423
run_test_tt_main suite
Loggerhead is a web-based interface for Breezy
Version: 2.0.1