mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-05 19:00:31 -05:00
Merge pull request #478 from jmid/cbor-roundtrip-prop-patch
Patch CBor round-trip QCheck test to hold for nan's too
This commit is contained in:
commit
3b49ad2a4e
1 changed files with 18 additions and 2 deletions
|
|
@ -99,12 +99,28 @@ let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t =
|
|||
let+ s = Q.Shrink.string s in
|
||||
`Bytes s
|
||||
|
||||
let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c;;
|
||||
let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c
|
||||
|
||||
let rec eq_c c c' =
|
||||
match c, c' with
|
||||
| `Null, `Null | `Undefined, `Undefined -> true
|
||||
| `Simple i, `Simple i' -> Int.equal i i'
|
||||
| `Bool b, `Bool b' -> Bool.equal b b'
|
||||
| `Int i, `Int i' -> Int64.equal i i'
|
||||
| `Float f, `Float f' -> Float.equal f f'
|
||||
| `Bytes s, `Bytes s' -> String.equal s s'
|
||||
| `Text t, `Text t' -> String.equal t t'
|
||||
| `Array a, `Array a' -> CCList.equal eq_c a a'
|
||||
| `Map m, `Map m' ->
|
||||
CCList.equal (fun (t0, t1) (t0', t1') -> eq_c t0 t0' && eq_c t1 t1') m m'
|
||||
| `Tag (i, t), `Tag (i', t') -> Int.equal i i' && eq_c t t'
|
||||
| _ -> false
|
||||
;;
|
||||
|
||||
q ~count:1_000 ~long_factor:10 arb @@ fun c ->
|
||||
let s = Cbor.encode c in
|
||||
let c' = Cbor.decode_exn s in
|
||||
if not (c = c') then
|
||||
if not (eq_c c c') then
|
||||
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
|
||||
Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
|
||||
true
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue