Skip to content

Commit

Permalink
add test that shows orphan tag
Browse files Browse the repository at this point in the history
  • Loading branch information
@jchavarri
jchavarri committed Nov 21, 2024
1 parent 2899658 commit 23a2466
Show file tree
Hide file tree
Showing 2 changed files with 276 additions and 0 deletions.
170 changes: 170 additions & 0 deletions ppx/test/ppx_deriving_json_js.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1239,3 +1239,173 @@

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

$ cat <<"EOF" | run
> type one = [ `C ] [@@deriving json] type other = [ `C ] [@@deriving json] type poly = [ one | other ] [@@deriving json]
> EOF
type one = [ `C ] [@@deriving json]

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

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

let rec one_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 "C" then (
if Stdlib.( <> ) len 1 then
Ppx_deriving_json_runtime.of_json_error
"expected a JSON array of length 1";
Some `C)
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 -> one option)

and one_of_json =
(fun x ->
match one_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Js.Json.t -> one)

let _ = one_of_json_poly
and _ = one_of_json

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

let rec one_to_json =
(fun x ->
match x with
| `C -> (Obj.magic [| (Obj.magic "C" : Js.Json.t) |] : Js.Json.t)
: one -> Js.Json.t)

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

type other = [ `C ] [@@deriving json]

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

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

let rec other_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 "C" then (
if Stdlib.( <> ) len 1 then
Ppx_deriving_json_runtime.of_json_error
"expected a JSON array of length 1";
Some `C)
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 -> other option)

and other_of_json =
(fun x ->
match other_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Js.Json.t -> other)

let _ = other_of_json_poly
and _ = other_of_json

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

let rec other_to_json =
(fun x ->
match x with
| `C -> (Obj.magic [| (Obj.magic "C" : Js.Json.t) |] : Js.Json.t)
: other -> Js.Json.t)

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

type poly = [ one | other ] [@@deriving json]

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

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

let rec poly_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
match one_of_json_poly x with
| Some x -> (Some x :> [ one | other ] option)
| None -> (
match other_of_json_poly x with
| Some x -> (Some x :> [ one | other ] option)
| None -> 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 -> poly option)

and poly_of_json =
(fun x ->
match poly_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Js.Json.t -> poly)

let _ = poly_of_json_poly
and _ = poly_of_json

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

let rec poly_to_json =
(fun x ->
match x with
| #one as x -> one_to_json x
| #other as x -> other_to_json x
: poly -> Js.Json.t)

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

106 changes: 106 additions & 0 deletions ppx/test/ppx_deriving_json_native.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -951,3 +951,109 @@

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

$ cat <<"EOF" | run
> type one = [ `C ] [@@deriving json] type other = [ `C ] [@@deriving json] type poly = [ one | other ] [@@deriving json]
> EOF
type one = [ `C ] [@@deriving json]

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

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

let rec one_of_json_poly =
(fun x ->
match x with `List (`String "C" :: []) -> Some `C | x -> None
: Yojson.Basic.t -> one option)

and one_of_json =
(fun x ->
match one_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Yojson.Basic.t -> one)

let _ = one_of_json_poly
and _ = one_of_json

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

let rec one_to_json =
(fun x -> match x with `C -> `List [ `String "C" ]
: one -> Yojson.Basic.t)

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

type other = [ `C ] [@@deriving json]

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

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

let rec other_of_json_poly =
(fun x ->
match x with `List (`String "C" :: []) -> Some `C | x -> None
: Yojson.Basic.t -> other option)

and other_of_json =
(fun x ->
match other_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Yojson.Basic.t -> other)

let _ = other_of_json_poly
and _ = other_of_json

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

let rec other_to_json =
(fun x -> match x with `C -> `List [ `String "C" ]
: other -> Yojson.Basic.t)

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

type poly = [ one | other ] [@@deriving json]

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

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

let rec poly_of_json_poly =
(fun x ->
match x with
| x -> (
match other_of_json_poly x with
| Some x -> (Some x :> [ one | other ] option)
| None -> (
match one_of_json_poly x with
| Some x -> (Some x :> [ one | other ] option)
| None -> None))
: Yojson.Basic.t -> poly option)

and poly_of_json =
(fun x ->
match poly_of_json_poly x with
| Some x -> x
| None -> Ppx_deriving_json_runtime.of_json_error "invalid JSON"
: Yojson.Basic.t -> poly)

let _ = poly_of_json_poly
and _ = poly_of_json

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

let rec poly_to_json =
(fun x ->
match x with
| #one as x -> one_to_json x
| #other as x -> other_to_json x
: poly -> Yojson.Basic.t)

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

0 comments on commit 23a2466

Please sign in to comment.