cleanrer interface for Univ

This commit is contained in:
Simon Cruanes 2013-03-14 14:43:08 +01:00
parent bf777e3d28
commit 707d29210f
3 changed files with 37 additions and 21 deletions

View file

@ -6,40 +6,40 @@ open OUnit
let test_val () = let test_val () =
let e1 = Univ.embed () in let e1 = Univ.embed () in
let e2 = Univ.embed () in let e2 = Univ.embed () in
let v1 = e1.Univ.pack 42 in let v1 = Univ.pack e1 42 in
let v2 = e2.Univ.pack "hello" in let v2 = Univ.pack e2 "hello" in
OUnit.assert_equal (Some 42) (e1.Univ.unpack v1); OUnit.assert_equal (Some 42) (Univ.unpack e1 v1);
OUnit.assert_equal None (e1.Univ.unpack v2); OUnit.assert_equal None (Univ.unpack e1 v2);
OUnit.assert_equal (Some "hello") (e2.Univ.unpack v2); OUnit.assert_equal (Some "hello") (Univ.unpack e2 v2);
OUnit.assert_equal None (e2.Univ.unpack v1); OUnit.assert_equal None (Univ.unpack e2 v1);
() ()
let test_compatible () = let test_compatible () =
let e1 = Univ.embed () in let e1 = Univ.embed () in
let e2 = Univ.embed () in let e2 = Univ.embed () in
let v1 = e1.Univ.pack 42 in let v1 = Univ.pack e1 42 in
let v2 = e2.Univ.pack "hello" in let v2 = Univ.pack e2 "hello" in
OUnit.assert_bool "compatible" (e1.Univ.compatible v1); OUnit.assert_bool "compatible" (Univ.compatible e1 v1);
OUnit.assert_bool "not compatible" (not (e1.Univ.compatible v2)); OUnit.assert_bool "not compatible" (not (Univ.compatible e1 v2));
OUnit.assert_bool "compatible" (e2.Univ.compatible v2); OUnit.assert_bool "compatible" (Univ.compatible e2 v2);
OUnit.assert_bool "not compatible" (not (e2.Univ.compatible v1)); OUnit.assert_bool "not compatible" (not (Univ.compatible e2 v1));
() ()
let test_set () = let test_set () =
let e1 = (Univ.embed () : int Univ.embedding) in let e1 = (Univ.embed () : int Univ.embedding) in
let e2 = (Univ.embed () : string Univ.embedding) in let e2 = (Univ.embed () : string Univ.embedding) in
(* create val *) (* create val *)
let v = e1.Univ.pack 42 in let v = Univ.pack e1 42 in
OUnit.assert_equal (Some 42) (e1.Univ.unpack v); OUnit.assert_equal (Some 42) (Univ.unpack e1 v);
OUnit.assert_equal None (e2.Univ.unpack v); OUnit.assert_equal None (Univ.unpack e2 v);
(* set content, keeping type *) (* set content, keeping type *)
e1.Univ.set v 100; Univ.set e1 v 100;
OUnit.assert_equal (Some 100) (e1.Univ.unpack v); OUnit.assert_equal (Some 100) (Univ.unpack e1 v);
OUnit.assert_equal None (e2.Univ.unpack v); OUnit.assert_equal None (Univ.unpack e2 v);
(* set content, changing type *) (* set content, changing type *)
e2.Univ.set v "hello"; Univ.set e2 v "hello";
OUnit.assert_equal None (e1.Univ.unpack v); OUnit.assert_equal None (Univ.unpack e1 v);
OUnit.assert_equal (Some "hello") (e2.Univ.unpack v); OUnit.assert_equal (Some "hello") (Univ.unpack e2 v);
() ()
let suite = let suite =

View file

@ -65,3 +65,11 @@ let embed () =
id == t.id id == t.id
in in
{ pack; unpack; compatible; set; } { pack; unpack; compatible; set; }
let pack emb x = emb.pack x
let unpack emb t = emb.unpack t
let compatible emb t = emb.compatible t
let set emb t x = emb.set t x

View file

@ -40,3 +40,11 @@ type 'a embedding = {
val embed : unit -> 'a embedding val embed : unit -> 'a embedding
(** Create a new embedding. Values packed by a given embedding can (** Create a new embedding. Values packed by a given embedding can
only be unpacked by the same embedding. *) only be unpacked by the same embedding. *)
val pack : 'a embedding -> 'a -> t
val unpack : 'a embedding -> t -> 'a option
val compatible : 'a embedding -> t -> bool
val set : 'a embedding -> t -> 'a -> unit