[Xen-API] [PATCH 16 of 17] [rpc-light] when (un)marshaling variant, if it has no arguments then consider it as a string

[Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>]

# 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 ++++++++++++++

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

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