Skip to content

Commit

Permalink
ppx: update tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@andreypopp
andreypopp committed Oct 7, 2024
1 parent c5647f7 commit 4773501
Show file tree
Hide file tree
Showing 5 changed files with 304 additions and 1 deletion.
6 changes: 5 additions & 1 deletion ppx/test/example.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,9 @@ type record = { name : string; age : int } [@@deriving json]
type record_aliased = { name : string; [@json.key "my_name"] age : int; [@json.key "my_age"] [@json.default 100] } [@@deriving json]
type record_opt = { k : int option; [@json.option] } [@@deriving json]
type sum = A | B of int | C of { name : string } [@@deriving json]
type sum2 = S2 of int * string [@@deriving json]
type other = [ `C ] [@@deriving json] type poly = [ `A | `B of int | other ] [@@deriving json]
type poly2 = [ `P2 of int * string ] [@@deriving json]
type 'a c = [ `C of 'a ] [@@deriving json]
type recur = A | Fix of recur [@@deriving json]
type polyrecur = [ `A | `Fix of polyrecur ] [@@deriving json]
Expand Down Expand Up @@ -36,8 +38,10 @@ module Cases = struct
C ({|["A"]|}, sum_of_json, sum_to_json, (A : sum));
C ({|["B", 42]|}, sum_of_json, sum_to_json, (B 42 : sum));
C ({|["C", {"name": "cname"}]|}, sum_of_json, sum_to_json, (C {name="cname"} : sum));
C ({|["A"]|}, poly_of_json, poly_to_json, (`A : poly));
C ({|["A"]|}, sum_of_json, sum_to_json, (A : sum));
C ({|["S2", 42, "hello"]|}, sum2_of_json, sum2_to_json, (S2 (42, "hello")));
C ({|["B", 42]|}, poly_of_json, poly_to_json, (`B 42 : poly));
C ({|["P2", 42, "hello"]|}, poly2_of_json, poly2_to_json, (`P2 (42, "hello") : poly2));
C ({|["Fix",["Fix",["Fix",["A"]]]]|}, recur_of_json, recur_to_json, (Fix (Fix (Fix A))));
C ({|["Fix",["Fix",["Fix",["A"]]]]|}, polyrecur_of_json, polyrecur_to_json, (`Fix (`Fix (`Fix `A))));
C ({|"A"|}, evar_of_json, evar_to_json, (A : evar));
Expand Down
4 changes: 4 additions & 0 deletions ppx/test/ppx_deriving_json_js.e2e.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,8 +54,12 @@
JSON REPRINT: ["C",{"name":"cname"}]
JSON DATA: ["A"]
JSON REPRINT: ["A"]
JSON DATA: ["S2", 42, "hello"]
JSON REPRINT: ["S2",42,"hello"]
JSON DATA: ["B", 42]
JSON REPRINT: ["B",42]
JSON DATA: ["P2", 42, "hello"]
JSON REPRINT: ["P2",42,"hello"]
JSON DATA: ["Fix",["Fix",["Fix",["A"]]]]
JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
JSON DATA: ["Fix",["Fix",["Fix",["A"]]]]
Expand Down
171 changes: 171 additions & 0 deletions ppx/test/ppx_deriving_json_js.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,29 @@
let _ = user_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type floaty = float [@@deriving json]
> EOF
type floaty = float [@@deriving json]

include struct
let _ = fun (_ : floaty) -> ()

[@@@ocaml.warning "-39-11-27"]

let rec floaty_of_json =
(fun x -> float_of_json x : Js.Json.t -> floaty)

let _ = floaty_of_json

[@@@ocaml.warning "-39-11-27"]

let rec floaty_to_json =
(fun x -> float_to_json x : floaty -> Js.Json.t)

let _ = floaty_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type 'a param = 'a [@@deriving json]
> EOF
Expand Down Expand Up @@ -65,6 +88,31 @@
let _ = opt_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type res = (int, string) result [@@deriving json]
> EOF
type res = (int, string) result [@@deriving json]
include struct
let _ = fun (_ : res) -> ()
[@@@ocaml.warning "-39-11-27"]
let rec res_of_json =
(fun x -> (result_of_json int_of_json string_of_json) x
: Js.Json.t -> res)
let _ = res_of_json
[@@@ocaml.warning "-39-11-27"]
let rec res_to_json =
(fun x -> (result_to_json int_to_json string_to_json) x
: res -> Js.Json.t)
let _ = res_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type tuple = int * string [@@deriving json]
> EOF
Expand Down Expand Up @@ -375,6 +423,63 @@
let _ = sum_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type sum2 = S2 of int * string [@@deriving json]
> EOF
type sum2 = S2 of int * string [@@deriving json]
include struct
let _ = fun (_ : sum2) -> ()
[@@@ocaml.warning "-39-11-27"]
let rec sum2_of_json =
(fun x ->
if Js.Array.isArray x then
let array = (Obj.magic x : Js.Json.t array) in
let len = Js.Array.length array in
if Stdlib.( > ) len 0 then
let tag = Js.Array.unsafe_get array 0 in
if Stdlib.( = ) (Js.typeof tag) "string" then
let tag = (Obj.magic tag : string) in
if Stdlib.( = ) tag "S2" then (
if Stdlib.( <> ) len 3 then
Ppx_deriving_json_runtime.of_json_error
"expected a JSON array of length 3";
S2
( int_of_json (Js.Array.unsafe_get array 1),
string_of_json (Js.Array.unsafe_get array 2) ))
else Ppx_deriving_json_runtime.of_json_error "invalid JSON"
else
Ppx_deriving_json_runtime.of_json_error
"expected a non empty JSON array with element being a \
string"
else
Ppx_deriving_json_runtime.of_json_error
"expected a non empty JSON array"
else
Ppx_deriving_json_runtime.of_json_error
"expected a non empty JSON array"
: Js.Json.t -> sum2)
let _ = sum2_of_json
[@@@ocaml.warning "-39-11-27"]
let rec sum2_to_json =
(fun x ->
match x with
| S2 (x_0, x_1) ->
(Obj.magic
[|
string_to_json "S2"; int_to_json x_0; string_to_json x_1;
|]
: Js.Json.t)
: sum2 -> Js.Json.t)
let _ = sum2_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type other = [ `C ] [@@deriving json] type poly = [ `A | `B of int | other ] [@@deriving json]
> EOF
Expand Down Expand Up @@ -478,6 +583,72 @@
let _ = poly_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type poly2 = [ `P2 of int * string ] [@@deriving json]
> EOF
type poly2 = [ `P2 of int * string ] [@@deriving json]
include struct
let _ = fun (_ : poly2) -> ()
[@@@ocaml.warning "-39-11-27"]
let rec poly2_of_json_poly =
(fun x ->
if Js.Array.isArray x then
let array = (Obj.magic x : Js.Json.t array) in
let len = Js.Array.length array in
if Stdlib.( > ) len 0 then
let tag = Js.Array.unsafe_get array 0 in
if Stdlib.( = ) (Js.typeof tag) "string" then
let tag = (Obj.magic tag : string) in
if Stdlib.( = ) tag "P2" then (
if Stdlib.( <> ) len 3 then
Ppx_deriving_json_runtime.of_json_error
"expected a JSON array of length 3";
Some
(`P2
( int_of_json (Js.Array.unsafe_get array 1),
string_of_json (Js.Array.unsafe_get array 2) )))
else None
else
Ppx_deriving_json_runtime.of_json_error
"expected a non empty JSON array with element being a \
string"
else
Ppx_deriving_json_runtime.of_json_error
"expected a non empty JSON array"
else
Ppx_deriving_json_runtime.of_json_error
"expected a non empty JSON array"
: Js.Json.t -> poly2 option)
and poly2_of_json =
(fun x ->
match poly2_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Js.Json.t -> poly2)
let _ = poly2_of_json_poly
and _ = poly2_of_json
[@@@ocaml.warning "-39-11-27"]
let rec poly2_to_json =
(fun x ->
match x with
| `P2 (x_0, x_1) ->
(Obj.magic
[|
string_to_json "P2"; int_to_json x_0; string_to_json x_1;
|]
: Js.Json.t)
: poly2 -> Js.Json.t)
let _ = poly2_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type 'a c = [ `C of 'a ] [@@deriving json]
> EOF
Expand Down
4 changes: 4 additions & 0 deletions ppx/test/ppx_deriving_json_native.e2e.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,8 +46,12 @@
JSON REPRINT: ["C",{"name":"cname"}]
JSON DATA: ["A"]
JSON REPRINT: ["A"]
JSON DATA: ["S2", 42, "hello"]
JSON REPRINT: ["S2",42,"hello"]
JSON DATA: ["B", 42]
JSON REPRINT: ["B",42]
JSON DATA: ["P2", 42, "hello"]
JSON REPRINT: ["P2",42,"hello"]
JSON DATA: ["Fix",["Fix",["Fix",["A"]]]]
JSON REPRINT: ["Fix",["Fix",["Fix",["A"]]]]
JSON DATA: ["Fix",["Fix",["Fix",["A"]]]]
Expand Down
120 changes: 120 additions & 0 deletions ppx/test/ppx_deriving_json_native.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,29 @@
let _ = user_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type floaty = float [@@deriving json]
> EOF
type floaty = float [@@deriving json]

include struct
let _ = fun (_ : floaty) -> ()

[@@@ocaml.warning "-39-11-27"]

let rec floaty_of_json =
(fun x -> float_of_json x : Yojson.Basic.t -> floaty)

let _ = floaty_of_json

[@@@ocaml.warning "-39-11-27"]

let rec floaty_to_json =
(fun x -> float_to_json x : floaty -> Yojson.Basic.t)

let _ = floaty_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type 'a param = 'a [@@deriving json]
> EOF
Expand Down Expand Up @@ -65,6 +88,31 @@
let _ = opt_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type res = (int, string) result [@@deriving json]
> EOF
type res = (int, string) result [@@deriving json]
include struct
let _ = fun (_ : res) -> ()
[@@@ocaml.warning "-39-11-27"]
let rec res_of_json =
(fun x -> (result_of_json int_of_json string_of_json) x
: Yojson.Basic.t -> res)
let _ = res_of_json
[@@@ocaml.warning "-39-11-27"]
let rec res_to_json =
(fun x -> (result_to_json int_to_json string_to_json) x
: res -> Yojson.Basic.t)
let _ = res_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]
$ cat <<"EOF" | run
> type tuple = int * string [@@deriving json]
> EOF
Expand Down Expand Up @@ -361,6 +409,38 @@
let _ = sum_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type sum2 = S2 of int * string [@@deriving json]
> EOF
type sum2 = S2 of int * string [@@deriving json]

include struct
let _ = fun (_ : sum2) -> ()

[@@@ocaml.warning "-39-11-27"]

let rec sum2_of_json =
(fun x ->
match x with
| `List [ `String "S2"; x_0; x_1 ] ->
S2 (int_of_json x_0, string_of_json x_1)
| _ -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Yojson.Basic.t -> sum2)

let _ = sum2_of_json

[@@@ocaml.warning "-39-11-27"]

let rec sum2_to_json =
(fun x ->
match x with
| S2 (x_0, x_1) ->
`List [ `String "S2"; int_to_json x_0; string_to_json x_1 ]
: sum2 -> Yojson.Basic.t)

let _ = sum2_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type other = [ `C ] [@@deriving json] type poly = [ `A | `B of int | other ] [@@deriving json]
> EOF
Expand Down Expand Up @@ -434,6 +514,46 @@
let _ = poly_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type poly2 = [ `P2 of int * string ] [@@deriving json]
> EOF
type poly2 = [ `P2 of int * string ] [@@deriving json]

include struct
let _ = fun (_ : poly2) -> ()

[@@@ocaml.warning "-39-11-27"]

let rec poly2_of_json_poly =
(fun x ->
match x with
| `List [ `String "P2"; x_0; x_1 ] ->
Some (`P2 (int_of_json x_0, string_of_json x_1))
| x -> None
: Yojson.Basic.t -> poly2 option)

and poly2_of_json =
(fun x ->
match poly2_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Yojson.Basic.t -> poly2)

let _ = poly2_of_json_poly
and _ = poly2_of_json

[@@@ocaml.warning "-39-11-27"]

let rec poly2_to_json =
(fun x ->
match x with
| `P2 (x_0, x_1) ->
`List [ `String "P2"; int_to_json x_0; string_to_json x_1 ]
: poly2 -> Yojson.Basic.t)

let _ = poly2_to_json
end [@@ocaml.doc "@inline"] [@@merlin.hide]

$ cat <<"EOF" | run
> type 'a c = [ `C of 'a ] [@@deriving json]
> EOF
Expand Down

0 comments on commit 4773501

Please sign in to comment.