# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID 28e332232a4922c6172a64055671272deef026b4
# Parent bca2a17d2f9e9af21773061a902be48f990c4f08
[rpc-light] when (un)marshaling variant, if it has no arguments then consider
it as a string.
This bit is also necessary to discuss with the SM backend.
Basically, if you have 'type t = Foo | Bar of int with rpc' you will consider
than the value Foo is actually the same thing as the string "Foo" (if you don't
want to have a capital letter, use polymorphic variants as 'type t = [ `foo |
`bar of int ]' which will give that the value `foo will be considered as the
string "foo").
Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
diff -r bca2a17d2f9e -r 28e332232a49 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
@@ -9,7 +9,8 @@
xapi \
option \
encoding \
- dict
+ dict \
+ variants
EXECS=$(foreach example, $(EXAMPLES), $(example).opt)
diff -r bca2a17d2f9e -r 28e332232a49 rpc-light/examples/variants.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/rpc-light/examples/variants.ml Fri Jan 08 13:47:46 2010 +0000
@@ -0,0 +1,16 @@
+type t = [ `foo | `bar of int * string ] with rpc
+
+let _ =
+ let t1 = `foo in
+ let t2 = `bar (3, "bar") in
+
+ let r1 = rpc_of_t t1 in
+ let r2 = rpc_of_t t2 in
+
+ Printf.printf "r1 = %s\nr2 = %s\n%!" (Rpc.to_string r1) (Rpc.to_string
r2);
+
+ let t1' = t_of_rpc r1 in
+ let t2' = t_of_rpc r2 in
+
+ Printf.printf "t1 = t1' : %b\nt2 = t2' : %b\n%!" (t1 = t1') (t2 = t2');
+ assert (t1 = t1' && t2 = t2')
diff -r bca2a17d2f9e -r 28e332232a49 rpc-light/examples/xapi.ml
--- a/rpc-light/examples/xapi.ml Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/examples/xapi.ml Fri Jan 08 13:47:46 2010 +0000
@@ -1,3 +1,23 @@
+let array_call =
+"<methodCall>
+ <methodName>event.register</methodName>
+ <params>
+ <param>
+ <value>OpaqueRef:8ecbbb2a-a905-d422-1153-fadc00639b12</value>
+ </param>
+ <param>
+ <value>
+ <array>
+ <data>
+ <value>pbd</value>
+ </data>
+ </array>
+ </value>
+ </param>
+ </params>
+</methodCall>
+"
+
let simple_call =
"<methodCall>
<methodName>session.login_with_password</methodName>
@@ -103,16 +123,18 @@
let _ =
Printf.printf "Parsing SM XML ... %!";
- Xmlrpc.response_of_string sm;
+ let _ = Xmlrpc.response_of_string sm in
Printf.printf "OK\nParsing empty tags ... %!";
- Xmlrpc.of_string empty;
+ let _ = Xmlrpc.of_string empty in
Printf.printf "OK\nParsing error ... %!";
- Xmlrpc.response_of_string error;
+ let _ = Xmlrpc.response_of_string error in
Printf.printf "OK\nParsing simple call ... %!";
- Xmlrpc.call_of_string simple_call;
+ let _ = Xmlrpc.call_of_string simple_call in
+
+ Printf.printf "OK\nParsing array call ... %!"
+ let _ = Xmlrpc.call_of_string array_call in
Printf.printf "OK\n%!"
-
diff -r bca2a17d2f9e -r 28e332232a49 rpc-light/p4_rpc.ml
--- a/rpc-light/p4_rpc.ml Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/p4_rpc.ml Fri Jan 08 13:47:46 2010 +0000
@@ -194,7 +194,11 @@
let ids, ctyps = decompose_variants _loc t in
let pattern (n, t) ctyps =
let ids, pids = new_id_list _loc ctyps in
- let body = <:expr< Rpc.Enum [ Rpc.String
$str:n$ :: $expr_list_of_list _loc (List.map2 create ids ctyps)$ ] >> in
+ let body =
+ if ids = [] then
+ <:expr< Rpc.String $str:n$ >>
+ else
+ <:expr< Rpc.Enum [ Rpc.String
$str:n$ :: $expr_list_of_list _loc (List.map2 create ids ctyps)$ ] >> in
<:match_case< $recompose_variant _loc (n,t)
pids$ -> $body$ >> in
let patterns = mcOr_of_list (List.map2 pattern ids
ctyps) in
<:expr< match $id$ with [ $patterns$ ] >>
@@ -356,7 +360,11 @@
let ids, ctyps = decompose_variants _loc t in
let pattern (n, t) ctyps =
let ids, pids = new_id_list _loc ctyps in
- let patt = <:patt< Rpc.Enum [ Rpc.String
$str:n$ :: $patt_list_of_list _loc pids$ ] >> in
+ let patt =
+ if ids = [] then
+ <:patt< Rpc.String $str:n$ >>
+ else
+ <:patt< Rpc.Enum [ Rpc.String
$str:n$ :: $patt_list_of_list _loc pids$ ] >> in
let exprs = List.map2 (create name) ids ctyps in
let body = List.fold_right
(fun a b -> <:expr< $b$ $a$ >>)
diff -r bca2a17d2f9e -r 28e332232a49 rpc-light/run_test
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/rpc-light/run_test Fri Jan 08 13:47:46 2010 +0000
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+make
+make uninstall
+make install
+
+make -C examples clean
+make -C examples
+
+./examples/all_types.opt
+./examples/xapi.opt
+./examples/option.opt
+./examples/dict.opt
+./examples/variants.opt
\ No newline at end of file
5 files changed, 69 insertions(+), 8 deletions(-)
rpc-light/examples/Makefile | 3 ++-
rpc-light/examples/variants.ml | 16 ++++++++++++++++
rpc-light/examples/xapi.ml | 32 +++++++++++++++++++++++++++-----
rpc-light/p4_rpc.ml | 12 ++++++++++--
rpc-light/run_test | 14 ++++++++++++++
xen-api-libs.hg-17.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|