[Xen-API] [PATCH 03 of 17] [rpc-light] test (un)marshalling of phatom types

[Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>]

# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID b1d07ffe0323c8e7384c2c7042098d12dac2eb23
# Parent  383e08728219228b6818b5f5274202e96c89786e
[rpc-light] test (un)marshalling of phatom types.

'type 'a t = string with rpc' has to work.

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>

diff -r 383e08728219 -r b1d07ffe0323 rpc-light/examples/Makefile
--- a/rpc-light/examples/Makefile       Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/examples/Makefile       Fri Jan 08 13:47:46 2010 +0000
@@ -3,7 +3,7 @@
 OCAMLFLAGS = -annot -g
 
 PACKS = rpc-light
-EXAMPLES = all_types
+EXAMPLES = all_types phantom
 
 EXECS=$(foreach example, $(EXAMPLES), $(example).opt)
 
@@ -18,7 +18,7 @@
 
 %_gen: %.ml
        camlp4o $(shell ocamlfind query rpc-light.syntax -r -format "-I %d %a" 
-predicates syntax,preprocessor) $< -printer o > $@.ml
-       $(OCAMLOPT) -package $(PACKS) -c -o $@ $@.ml
+       $(OCAMLOPT) $(OCAMLFLAGS) -package $(PACKS) -c -o $@ $@.ml
 
 clean:
        rm -f *.cmx *.cmi *.cmo *.cmxa *.o $(EXECS)
\ No newline at end of file
diff -r 383e08728219 -r b1d07ffe0323 rpc-light/examples/phantom.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/rpc-light/examples/phantom.ml     Fri Jan 08 13:47:46 2010 +0000
@@ -0,0 +1,42 @@
+module P : sig
+       type 'a t
+       val rpc_of_t: ('a -> Rpc.t) -> 'a t -> Rpc.t
+       val t_of_rpc: (Rpc.t -> 'a) -> Rpc.t -> 'a t
+       val to_string: 'a t -> string
+       val of_string: string -> 'a t
+end = struct
+       type 'a t = string with rpc
+       let to_string x = x
+       let of_string x = x
+end
+
+module Q = struct
+       include P
+       let rpc_of_t _ x = Rpc.rpc_of_string (to_string x)
+       let t_of_rpc _ x = of_string (Rpc.string_of_rpc x)
+end
+
+type x = [`foo] Q.t with rpc
+type y = [`bar] Q.t with rpc
+
+let _ =
+       let p : [`p] P.t = P.of_string "foo" in
+       let q : [`q] P.t = P.of_string "foo" in
+       let x : x = P.of_string "foo" in
+       let y : y = P.of_string "foo" in
+
+       let p_rpc = Q.rpc_of_t () p in
+       let q_rpc = Q.rpc_of_t () q in
+       let x_rpc = rpc_of_x x in
+       let y_rpc = rpc_of_y y in
+
+       let _ : [`p] P.t = Q.t_of_rpc () p_rpc in
+       let _ : [`q] P.t = Q.t_of_rpc () q_rpc in
+       let _ : x = x_of_rpc x_rpc in
+       let _ : y = y_of_rpc y_rpc in
+
+       Printf.printf "p=%s\n" (Xmlrpc.to_string p_rpc);
+       Printf.printf "q=%s\n" (Xmlrpc.to_string q_rpc);
+       Printf.printf "x=%s\n" (Xmlrpc.to_string x_rpc);
+       Printf.printf "y=%s\n" (Xmlrpc.to_string y_rpc)
+
2 files changed, 44 insertions(+), 2 deletions(-)
rpc-light/examples/Makefile   |    4 +--
rpc-light/examples/phantom.ml |   42 +++++++++++++++++++++++++++++++++++++++++

xen-api-libs.hg-17.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api