Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Normalize indentation (tab -> 2 spaces)

  • Loading branch information...
commit ae30bf2488a62f88f437d9fe5d22520bd9504e94 1 parent d468f80
@samoht authored
View
165 tests/all_types.ml
@@ -12,91 +12,94 @@
* GNU Lesser General Public License for more details.
*)
-type t = Foo of int | Bar of (int * float) with rpc
+type t =
+ | Foo of int
+ | Bar of (int * float)
+ with rpc
module M = struct
- type m = t with rpc
+ type m = t with rpc
end
type 'a x = {
- foo: M.m;
- bar: string;
- gna: float list;
- f1: (int option * bool list * float list list) option;
- f2: (string * string list) array;
- f3: int32;
- f4: int64;
- f5: int;
- f6: (unit * char) list;
- f7: 'a list;
- progress: int array;
- } with rpc ("f5" -> "type", "f7" -> "let")
+ foo: M.m;
+ bar: string;
+ gna: float list;
+ f1: (int option * bool list * float list list) option;
+ f2: (string * string list) array;
+ f3: int32;
+ f4: int64;
+ f5: int;
+ f6: (unit * char) list;
+ f7: 'a list;
+ progress: int array;
+} with rpc ("f5" -> "type", "f7" -> "let")
let _ =
- let x = {
- foo= Foo 3;
- bar= "ha ha";
- gna=[1.; 2.; 3.; 4.; Unix.gettimeofday () ];
- f2 = [| "hi",["hi"]; "hou",["hou";"hou"]; "foo", ["b";"a";"r"] |];
- f1 = Some (None, [true], [[1.]; [2.;3.]]);
- f3 = Int32.max_int;
- f4 = Int64.max_int;
- f5 = max_int;
- f6 = [ (),'a' ; (),'b' ; (),'c'; (),'d' ; (),'e' ];
- f7 = [ Foo 1; Foo 2; Foo 3 ];
- progress = [| 0; 1; 2; 3; 4; 5 |];
- } in
-
- (* Testing basic marshalling/unmarshalling *)
-
- let rpc = rpc_of_x M.rpc_of_m x in
-
- let rpc_xml = Xmlrpc.to_string rpc in
- let rpc_json = Jsonrpc.to_string rpc in
-
- Printf.printf "\n==rpc_xml==\n%s\n" rpc_xml;
- Printf.printf "\n==json==\n%s\n" rpc_json;
-
- let callback fields value = match (fields, value) with
- | ["progress"], Rpc.Int i -> Printf.printf "Progress: %Ld\n" i
- | _ -> ()
- in
- let x_xml = x_of_rpc M.m_of_rpc (Xmlrpc.of_string ~callback rpc_xml) in
- let x_json = x_of_rpc M.m_of_rpc (Jsonrpc.of_string rpc_json) in
-
- Printf.printf "\n==Sanity check 1==\nx=x_xml: %b\nx=x_json: %b\n" (x = x_xml) (x = x_json);
- assert (x = x_xml && x = x_json);
-
- (* Testing calls and responses *)
-
- let call = Rpc.call "foo" [ rpc; Rpc.String "Mouhahahaaaaa" ] in
- let success = Rpc.success rpc in
- let failure = Rpc.failure rpc in
-
- let c_xml_str = Xmlrpc.string_of_call call in
- let s_xml_str = Xmlrpc.string_of_response success in
- let f_xml_str = Xmlrpc.string_of_response failure in
-
- let c_json_str = Jsonrpc.string_of_call call in
- let s_json_str = Jsonrpc.string_of_response success in
- let f_json_str = Jsonrpc.string_of_response failure in
-
- Printf.printf "\n==call==\n %s\n%s\n" c_xml_str c_json_str;
- Printf.printf "\n==success==\n %s\n%s\n" s_xml_str s_json_str;
- Printf.printf "\n==failure==\n %s\n%s\n" f_xml_str f_json_str;
-
- let c_xml = Xmlrpc.call_of_string c_xml_str in
- let s_xml = Xmlrpc.response_of_string s_xml_str in
- let f_xml = Xmlrpc.response_of_string f_xml_str in
-
- Printf.printf "\n==Sanity check 2==\ncall=c_xml: %b\nsuccess=s_xml: %b\nfailure=f_xml: %b\n"
- (call = c_xml) (success = s_xml) (failure = f_xml);
- assert (call = c_xml && success = s_xml && failure = f_xml);
-
- let c_json = Jsonrpc.call_of_string c_json_str in
- let s_json = Jsonrpc.response_of_string s_json_str in
- let f_json = Jsonrpc.response_of_string f_json_str in
-
- Printf.printf "\n==Sanity check 3==\ncall=c_json': %b\nsuccess=s_json': %b\nfailure=f_json': %b\n"
- (call = c_json) (success = s_json) (failure = f_json);
- assert (call = c_json && success = s_json && failure = f_json)
+ let x = {
+ foo= Foo 3;
+ bar= "ha ha";
+ gna=[1.; 2.; 3.; 4.; Unix.gettimeofday () ];
+ f2 = [| "hi",["hi"]; "hou",["hou";"hou"]; "foo", ["b";"a";"r"] |];
+ f1 = Some (None, [true], [[1.]; [2.;3.]]);
+ f3 = Int32.max_int;
+ f4 = Int64.max_int;
+ f5 = max_int;
+ f6 = [ (),'a' ; (),'b' ; (),'c'; (),'d' ; (),'e' ];
+ f7 = [ Foo 1; Foo 2; Foo 3 ];
+ progress = [| 0; 1; 2; 3; 4; 5 |];
+ } in
+
+ (* Testing basic marshalling/unmarshalling *)
+
+ let rpc = rpc_of_x M.rpc_of_m x in
+
+ let rpc_xml = Xmlrpc.to_string rpc in
+ let rpc_json = Jsonrpc.to_string rpc in
+
+ Printf.printf "\n==rpc_xml==\n%s\n" rpc_xml;
+ Printf.printf "\n==json==\n%s\n" rpc_json;
+
+ let callback fields value =
+ match (fields, value) with
+ | ["progress"], Rpc.Int i -> Printf.printf "Progress: %Ld\n" i
+ | _ -> () in
+ let x_xml = x_of_rpc M.m_of_rpc (Xmlrpc.of_string ~callback rpc_xml) in
+ let x_json = x_of_rpc M.m_of_rpc (Jsonrpc.of_string rpc_json) in
+
+ Printf.printf "\n==Sanity check 1==\nx=x_xml: %b\nx=x_json: %b\n" (x = x_xml) (x = x_json);
+ assert (x = x_xml && x = x_json);
+
+ (* Testing calls and responses *)
+
+ let call = Rpc.call "foo" [ rpc; Rpc.String "Mouhahahaaaaa" ] in
+ let success = Rpc.success rpc in
+ let failure = Rpc.failure rpc in
+
+ let c_xml_str = Xmlrpc.string_of_call call in
+ let s_xml_str = Xmlrpc.string_of_response success in
+ let f_xml_str = Xmlrpc.string_of_response failure in
+
+ let c_json_str = Jsonrpc.string_of_call call in
+ let s_json_str = Jsonrpc.string_of_response success in
+ let f_json_str = Jsonrpc.string_of_response failure in
+
+ Printf.printf "\n==call==\n %s\n%s\n" c_xml_str c_json_str;
+ Printf.printf "\n==success==\n %s\n%s\n" s_xml_str s_json_str;
+ Printf.printf "\n==failure==\n %s\n%s\n" f_xml_str f_json_str;
+
+ let c_xml = Xmlrpc.call_of_string c_xml_str in
+ let s_xml = Xmlrpc.response_of_string s_xml_str in
+ let f_xml = Xmlrpc.response_of_string f_xml_str in
+
+ Printf.printf "\n==Sanity check 2==\ncall=c_xml: %b\nsuccess=s_xml: %b\nfailure=f_xml: %b\n"
+ (call = c_xml) (success = s_xml) (failure = f_xml);
+ assert (call = c_xml && success = s_xml && failure = f_xml);
+
+ let c_json = Jsonrpc.call_of_string c_json_str in
+ let s_json = Jsonrpc.response_of_string s_json_str in
+ let f_json = Jsonrpc.response_of_string f_json_str in
+
+ Printf.printf "\n==Sanity check 3==\ncall=c_json': %b\nsuccess=s_json': %b\nfailure=f_json': %b\n"
+ (call = c_json) (success = s_json) (failure = f_json);
+ assert (call = c_json && success = s_json && failure = f_json)
View
60 tests/client.ml
@@ -1,5 +1,3 @@
-
-
module Impl = struct
type context = unit
@@ -13,15 +11,15 @@ module Impl = struct
let rpc2 context ?opt v =
(match opt with
- | Some s -> Printf.printf "Got an optional string: %s" s;
- | None -> ());
+ | Some s -> Printf.printf "Got an optional string: %s" s;
+ | None -> ());
match v with
- | Idl_test.Foo ss ->
- Printf.printf "Foo: [%s]\n" (String.concat ";" ss)
- | Idl_test.Bar ->
- Printf.printf "Bar\n"
- | Idl_test.Baz f ->
- Printf.printf "Baz: %f\n" f
+ | Idl_test.Foo ss ->
+ Printf.printf "Foo: [%s]\n" (String.concat ";" ss)
+ | Idl_test.Bar ->
+ Printf.printf "Bar\n"
+ | Idl_test.Baz f ->
+ Printf.printf "Baz: %f\n" f
let rpc3 context i =
Printf.printf "%Ld\n" i;
@@ -39,27 +37,27 @@ module MyServer=Idl_test.Server(Impl)
let rpc call =
let call_string = Jsonrpc.string_of_call call in
Printf.printf "rpc function: call_string='%s'\n" call_string;
- let call = Jsonrpc.call_of_string call_string in
- let response = MyServer.process () call in
- let response_str = Jsonrpc.string_of_response response in
- Printf.printf "rpc function: response_string = '%s'\n" response_str;
- Jsonrpc.response_of_string response_str
+ let call = Jsonrpc.call_of_string call_string in
+ let response = MyServer.process () call in
+ let response_str = Jsonrpc.string_of_response response in
+ Printf.printf "rpc function: response_string = '%s'\n" response_str;
+ Jsonrpc.response_of_string response_str
-let _ =
+let _ =
let result = Idl_test.Client.rpc1 rpc ~arg1:"test argument" 2 in
- Printf.printf "result.result='%s', metadata=[%s]\n"
- result.Idl_test.result (String.concat ";" (List.map (fun (a,b) -> Printf.sprintf "(%d,%d)" a b) result.Idl_test.metadata));
+ Printf.printf "result.result='%s', metadata=[%s]\n"
+ result.Idl_test.result (String.concat ";" (List.map (fun (a,b) -> Printf.sprintf "(%d,%d)" a b) result.Idl_test.metadata));
- begin try
- let result = Idl_test.Client.rpc1 rpc ~arg1:"test argument" 5 in
- Printf.printf "result.result='%s', metadata=[%s]\n"
- result.Idl_test.result (String.concat ";" (List.map (fun (a,b) -> Printf.sprintf "(%d,%d)" a b) result.Idl_test.metadata));
- with
- | Idl_test.RpcFailure (msg,info) ->
- Printf.printf "Got a failure: %s\n" msg
- end;
- Idl_test.Client.rpc2 rpc (Idl_test.Foo ["hello";"there"]);
- Idl_test.Client.rpc2 rpc ~opt:"Optional" (Idl_test.Foo ["hello";"there"]);
- let i = Idl_test.Client.rpc3 rpc 999999999999999999L in
- Printf.printf "%Ld\n" i;
- Idl_test.Client.SubModule.rpc4 rpc 3L
+ begin try
+ let result = Idl_test.Client.rpc1 rpc ~arg1:"test argument" 5 in
+ Printf.printf "result.result='%s', metadata=[%s]\n"
+ result.Idl_test.result (String.concat ";" (List.map (fun (a,b) -> Printf.sprintf "(%d,%d)" a b) result.Idl_test.metadata));
+ with
+ | Idl_test.RpcFailure (msg,info) ->
+ Printf.printf "Got a failure: %s\n" msg
+ end;
+ Idl_test.Client.rpc2 rpc (Idl_test.Foo ["hello";"there"]);
+ Idl_test.Client.rpc2 rpc ~opt:"Optional" (Idl_test.Foo ["hello";"there"]);
+ let i = Idl_test.Client.rpc3 rpc 999999999999999999L in
+ Printf.printf "%Ld\n" i;
+ Idl_test.Client.SubModule.rpc4 rpc 3L
View
14 tests/dict.ml
@@ -2,11 +2,11 @@ type key = string with rpc
type t = (key * float) list with rpc
-let _ =
- let t = [ "foo", 3. ; "bar", 4. ] in
- let r = rpc_of_t t in
- Printf.printf "r = %s\n%!" (Rpc.to_string r);
+let _ =
+ let t = [ "foo", 3. ; "bar", 4. ] in
+ let r = rpc_of_t t in
+ Printf.printf "r = %s\n%!" (Rpc.to_string r);
- let t' = t_of_rpc r in
- Printf.printf "t = t' : %b\n%!" (t = t');
- assert (t = t')
+ let t' = t_of_rpc r in
+ Printf.printf "t = t' : %b\n%!" (t = t');
+ assert (t = t')
View
13 tests/idl_test.ml
@@ -1,19 +1,20 @@
(* Example IDL *)
type return_record = {
- result : string;
- metadata : (int * int) list;
+ result : string;
+ metadata : (int * int) list;
}
-type variant = | Foo of string list
- | Bar
- | Baz of float
+type variant =
+ | Foo of string list
+ | Bar
+ | Baz of float
external rpc1 : arg1:string -> int -> return_record = ""
external rpc2 : ?opt:string -> variant -> unit = ""
external rpc3 : int64 -> int64 = ""
module SubModule = struct
- external rpc4 : int64 -> int64 = ""
+ external rpc4 : int64 -> int64 = ""
end
View
32 tests/idl_test.mli
@@ -1,24 +1,32 @@
type return_record = { result : string; metadata : (int * int) list; }
+
type variant = Foo of string list | Bar | Baz of float
+
type failure = string * (string * string) list
+
exception RpcFailure of (string * (string * string) list)
-module Client :
- sig
- val rpc1 :
- (Rpc.call -> Rpc.response) -> arg1:string -> int -> return_record
- val rpc2 : (Rpc.call -> Rpc.response) -> ?opt:string -> variant -> unit
- val rpc3 : (Rpc.call -> Rpc.response) -> int64 -> int64
- module SubModule :
- sig val rpc4 : (Rpc.call -> Rpc.response) -> int64 -> int64 end
+
+module Client : sig
+ val rpc1 : (Rpc.call -> Rpc.response) -> arg1:string -> int -> return_record
+ val rpc2 : (Rpc.call -> Rpc.response) -> ?opt:string -> variant -> unit
+ val rpc3 : (Rpc.call -> Rpc.response) -> int64 -> int64
+ module SubModule : sig
+ val rpc4 : (Rpc.call -> Rpc.response) -> int64 -> int64
end
+end
+
module type Server_impl =
sig
type context
val rpc1 : context -> arg1:string -> int -> return_record
val rpc2 : context -> ?opt:string -> variant -> unit
val rpc3 : context -> int64 -> int64
- module SubModule : sig val rpc4 : context -> int64 -> int64 end
+ module SubModule : sig
+ val rpc4 : context -> int64 -> int64
+ end
end
-module Server :
- functor (Impl : Server_impl) ->
- sig val process : Impl.context -> Rpc.call -> Rpc.response end
+
+module Server : functor (Impl : Server_impl) ->
+sig
+ val process : Impl.context -> Rpc.call -> Rpc.response
+end
View
16 tests/json.ml
@@ -6,12 +6,12 @@ let good = "
"
let _ =
- Printf.printf "Parsing good JSON ... %!";
- let _ = Jsonrpc.of_string good in
+ Printf.printf "Parsing good JSON ... %!";
+ let _ = Jsonrpc.of_string good in
- begin try
- Printf.printf "OK\nParsing bad JSON ... %!";
- let _ = Jsonrpc.of_string bad in
- failwith "The bad JSON should have generated a parse failure"
- with e -> Printf.printf "Caught %s:\nOK\n%!" (Printexc.to_string e)
- end
+ try
+ Printf.printf "OK\nParsing bad JSON ... %!";
+ let _ = Jsonrpc.of_string bad in
+ failwith "The bad JSON should have generated a parse failure"
+ with e ->
+ Printf.printf "Caught %s:\nOK\n%!" (Printexc.to_string e)
View
30 tests/option.ml
@@ -1,22 +1,22 @@
type t = {
- foo : int option;
- bar : int list option;
- gni : int list;
- gna : int * (int option)
+ foo : int option;
+ bar : int list option;
+ gni : int list;
+ gna : int * (int option)
} with rpc
let _ =
- let t1 = { foo = None; bar = None; gni = []; gna = 1, None } in
- let t2 = { foo = None; bar = Some []; gni = [1]; gna = 1, None } 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 = { foo = None; bar = None; gni = []; gna = 1, None } in
+ let t2 = { foo = None; bar = Some []; gni = [1]; gna = 1, None } 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
+ let t1' = t_of_rpc r1 in
+ let t2' = t_of_rpc r2 in
- Printf.printf "t1 = t1' : %b\n%!" (t1=t1');
- assert (t1 = t1');
+ Printf.printf "t1 = t1' : %b\n%!" (t1=t1');
+ assert (t1 = t1');
- Printf.printf "t2 = t2' : %b\n%!" (t2 = t2');
- assert (t2 = t2')
+ Printf.printf "t2 = t2' : %b\n%!" (t2 = t2');
+ assert (t2 = t2')
View
54 tests/phantom.ml
@@ -1,42 +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
+ 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
+ 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)
+ 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 : [`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_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
+ 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)
+ 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)
View
18 tests/variants.ml
@@ -1,16 +1,16 @@
type t = [ `foo | `bar of int * string ] with rpc
let _ =
- let t1 = `foo in
- let t2 = `bar (3, "bar") in
+ let t1 = `foo in
+ let t2 = `bar (3, "bar") in
- let r1 = rpc_of_t t1 in
- let r2 = rpc_of_t t2 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);
+ 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
+ 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')
+ Printf.printf "t1 = t1' : %b\nt2 = t2' : %b\n%!" (t1 = t1') (t2 = t2');
+ assert (t1 = t1' && t2 = t2')
View
26 tests/xapi.ml
@@ -1,4 +1,4 @@
-let array_call =
+let array_call =
"<methodCall>
<methodName>event.register</methodName>
<params>
@@ -35,7 +35,7 @@ let simple_call =
</methodCall>
"
-let error =
+let error =
"<methodResponse>
<fault>
<value><struct>
@@ -122,19 +122,19 @@ let sm =
let empty = "<value></value>"
let _ =
- Printf.printf "Parsing SM XML ... %!";
- let _ = Xmlrpc.response_of_string sm in
+ Printf.printf "Parsing SM XML ... %!";
+ let _ = Xmlrpc.response_of_string sm in
- Printf.printf "OK\nParsing empty tags ... %!";
- let _ = Xmlrpc.of_string empty in
+ Printf.printf "OK\nParsing empty tags ... %!";
+ let _ = Xmlrpc.of_string empty in
- Printf.printf "OK\nParsing error ... %!";
- let _ = Xmlrpc.response_of_string error in
+ Printf.printf "OK\nParsing error ... %!";
+ let _ = Xmlrpc.response_of_string error in
- Printf.printf "OK\nParsing simple call ... %!";
- let _ = Xmlrpc.call_of_string simple_call in
+ Printf.printf "OK\nParsing 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\nParsing array call ... %!";
+ let _ = Xmlrpc.call_of_string array_call in
- Printf.printf "OK\n%!"
+ Printf.printf "OK\n%!"
Please sign in to comment.
Something went wrong with that request. Please try again.