# HG changeset patch # User Thomas Gazagnaire <[email protected]> # Date 1262958466 0 # Node ID 8e5e1af38c22077f98510231918d83ff5c715e05 # Parent 91091e97839df807f73ddbd9ff40ab1e13d7753d [rpc-light] Add some explicit runtime exceptions when an runtime error occurs.
A friendly error message is displayed as well if Rpc.set_debug true is called before. Signed-off-by: Thomas Gazagnaire <[email protected]> diff -r 91091e97839d -r 8e5e1af38c22 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 @@ -103,7 +103,6 @@ let new_id_list _loc l = List.split (List.map (fun _ -> new_id _loc) l) -exception Type_not_supported of ctyp let type_not_supported ty = let module PP = Camlp4.Printers.OCaml.Make(Syntax) in let pp = new PP.printer () in @@ -216,121 +215,126 @@ let str_of_id id = match id with <:e...@loc< $lid:s$ >> -> <:e...@loc< $str:s$ >> | _ -> assert false - let runtime_error id expected = + let runtime_error name id expected = let _loc = Loc.ghost in - <:match_case< __x__ -> - failwith (Printf.sprintf "Runtime error while parsing '%s': got '%s' while '%s' was expected\\n" $str_of_id id$ (Rpc.to_string __x__) $str:expected$) + <:match_case< __x__ -> do { + if Rpc.get_debug () then + Printf.eprintf "Runtime error in '%s_of_rpc:%s': got '%s' when '%s' was expected\\n" $str:name$ $str_of_id id$ (Rpc.to_string __x__) $str:expected$ + else (); + raise (Rpc.Runtime_error ($str:expected$, __x__)) } >> - let runtime_exn_error id doing = + let runtime_exn_error name id doing = let _loc = Loc.ghost in - <:match_case< __x__ -> - failwith (Printf.sprintf "Runtime error while parsing '%s': got exception '%s' while doing '%s'\\n" $str_of_id id$ (Printexc.to_string __x__) $str:doing$) - >> + <:match_case< __x__ -> do { + if Rpc.get_debug () then + Printf.eprintf "Runtime error in '%s_of_rpc:%s': caught exception '%s' while doing '%s'\\n" $str:name$ $str_of_id id$ (Printexc.to_string __x__) $str:doing$ + else () ; + raise (Rpc.Runtime_exception ($str:doing$, Printexc.to_string __x__)) } >> - let rec create id ctyp = + let rec create name id ctyp = let _loc = loc_of_ctyp ctyp in match ctyp with - | <:ctyp< unit >> -> <:expr< match $id$ with [ Rpc.Null -> () | $runtime_error id "Null"$ ] >> + | <:ctyp< unit >> -> <:expr< match $id$ with [ Rpc.Null -> () | $runtime_error name id "Null"$ ] >> | <:ctyp< int >> -> <:expr< match $id$ with [ Rpc.Int x -> Int64.to_int x | Rpc.String s -> int_of_string s - | $runtime_error id "Int(int)"$ ] >> + | $runtime_error name id "Int(int)"$ ] >> | <:ctyp< int32 >> -> <:expr< match $id$ with [ Rpc.Int x -> Int64.to_int32 x | Rpc.String s -> Int32.of_string s - | $runtime_error id "Int(int32)"$ ] >> + | $runtime_error name id "Int(int32)"$ ] >> | <:ctyp< int64 >> -> <:expr< match $id$ with [ Rpc.Int x -> x | Rpc.String s -> Int64.of_string s - | $runtime_error id "Int(int64)"$ ] >> + | $runtime_error name id "Int(int64)"$ ] >> | <:ctyp< float >> -> <:expr< match $id$ with [ Rpc.Float x -> x | Rpc.String s -> float_of_string s - | $runtime_error id "Float"$ ] >> + | $runtime_error name id "Float"$ ] >> | <:ctyp< char >> -> <:expr< match $id$ with [ Rpc.Int x -> Char.chr (Int64.to_int x) | Rpc.String s -> Char.chr (int_of_string s) - | $runtime_error id "Int(char)"$ ] >> + | $runtime_error name id "Int(char)"$ ] >> - | <:ctyp< string >> -> <:expr< match $id$ with [ Rpc.String x -> x | $runtime_error id "String(string)"$ ] >> - | <:ctyp< bool >> -> <:expr< match $id$ with [ Rpc.Bool x -> x | $runtime_error id "Bool"$ ] >> + | <:ctyp< string >> -> <:expr< match $id$ with [ Rpc.String x -> x | $runtime_error name id "String(string)"$ ] >> + | <:ctyp< bool >> -> <:expr< match $id$ with [ Rpc.Bool x -> x | $runtime_error name id "Bool"$ ] >> | <:ctyp< [< $t$ ] >> | <:ctyp< [> $t$ ] >> | <:ctyp< [= $t$ ] >> | <:ctyp< [ $t$ ] >> -> 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 exprs = List.map2 create ids ctyps in + let exprs = List.map2 (create name) ids ctyps in let body = List.fold_right (fun a b -> <:expr< $b$ $a$ >>) (List.rev exprs) (if t = `V then <:expr< $uid:n$ >> else <:expr< `$uid:n$ >>) in <:match_case< $patt$ -> $body$ >> in - let fail_match = <:match_case< $runtime_error id "Enum[String s;...]"$ >> in + let fail_match = <:match_case< $runtime_error name id "Enum[String s;...]"$ >> in let patterns = mcOr_of_list (List.map2 pattern ids ctyps @ [ fail_match ]) in <:expr< match $id$ with [ $patterns$ ] >> | <:ctyp< option $t$ >> -> let nid, npid = new_id _loc in - <:expr< match $id$ with [ Rpc.Enum [] -> None | Rpc.Enum [ $npid$ ] -> Some $create nid t$ | $runtime_error id "Enum[]/Enum[_]"$ ] >> + <:expr< match $id$ with [ Rpc.Enum [] -> None | Rpc.Enum [ $npid$ ] -> Some $create name nid t$ | $runtime_error name id "Enum[]/Enum[_]"$ ] >> | <:ctyp< $tup:tp$ >> -> let ctyps = list_of_ctyp tp [] in let ids, pids = new_id_list _loc ctyps in - let exprs = List.map2 create ids ctyps in + let exprs = List.map2 (create name) ids ctyps in <:expr< match $id$ with - [ Rpc.Enum $patt_list_of_list _loc pids$ -> $expr_tuple_of_list _loc exprs$ | $runtime_error id "List"$ ] + [ Rpc.Enum $patt_list_of_list _loc pids$ -> $expr_tuple_of_list _loc exprs$ | $runtime_error name id "List"$ ] >> | <:ctyp< list $t$ >> -> let nid, npid = new_id _loc in let nid2, npid2 = new_id _loc in <:expr< match $id$ with - [ Rpc.Enum $npid$ -> List.map (fun $npid2$ -> $create nid2 t$) $nid$ | $runtime_error id "List"$ ] + [ Rpc.Enum $npid$ -> List.map (fun $npid2$ -> $create name nid2 t$) $nid$ | $runtime_error name id "List"$ ] >> | <:ctyp< array $t$ >> -> let nid, npid = new_id _loc in let nid2, npid2 = new_id _loc in <:expr< match $id$ with - [ Rpc.Enum $npid$ -> Array.of_list (List.map (fun $npid2$ -> $create nid2 t$) $nid$) | $runtime_error id "List"$ ] + [ Rpc.Enum $npid$ -> Array.of_list (List.map (fun $npid2$ -> $create name nid2 t$) $nid$) | $runtime_error name id "List"$ ] >> | <:ctyp< { $t$ } >> -> let nid, npid = new_id _loc in let fields = decompose_fields _loc t in let ids, pids = new_id_list _loc fields in - let exprs = List.map2 (fun id (n, ctyp) -> <:rec_binding< $lid:n$ = $create id ctyp$ >>) ids fields in + let exprs = List.map2 (fun id (n, ctyp) -> <:rec_binding< $lid:n$ = $create name id ctyp$ >>) ids fields in let bindings = List.map2 (fun pid (n, ctyp) -> - <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error nid ("Looking for key "^n)$ ] >> + <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error name nid ("Looking for key "^n)$ ] >> ) pids fields in <:expr< match $id$ with - [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in { $rbSem_of_list exprs$ } | $runtime_error id "Dict"$ ] + [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in { $rbSem_of_list exprs$ } | $runtime_error name id "Dict"$ ] >> | <:ctyp< < $t$ > >> -> let nid, npid = new_id _loc in let fields = decompose_fields _loc t in let ids, pids = new_id_list _loc fields in - let exprs = List.map2 (fun id (n, ctyp) -> <:class_str_item< method $lid:n$ = $create id ctyp$ >>) ids fields in + let exprs = List.map2 (fun id (n, ctyp) -> <:class_str_item< method $lid:n$ = $create name id ctyp$ >>) ids fields in let bindings = List.map2 (fun pid (n, ctyp) -> - <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error nid ("Looking for key "^n)$ ] >> + <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error name nid ("Looking for key "^n)$ ] >> ) pids fields in <:expr< match $id$ with - [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in object $crSem_of_list exprs$ end | $runtime_error id "Dict"$ ] + [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in object $crSem_of_list exprs$ end | $runtime_error name id "Dict"$ ] >> | <:ctyp< '$lid:a$ >> -> <:expr< $lid:of_rpc_polyvar a$ $id$ >> @@ -338,8 +342,8 @@ | <:ctyp< $lid:t$ >> -> <:expr< $lid:of_rpc t$ $id$ >> | <:ctyp< $id:m$ . $lid:t$ >> -> <:expr< $id:m$ . $lid:of_rpc t$ $id$ >> - | <:ctyp< $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i create id None t a - | <:ctyp< $id:m$ . $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i create id (Some m) t a + | <:ctyp< $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i (create name) id None t a + | <:ctyp< $id:m$ . $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i (create name) id (Some m) t a | _ -> type_not_supported ctyp @@ -349,7 +353,7 @@ <:binding< $lid:of_rpc name$ = $List.fold_left (fun accu arg -> <:expr< fun $lid:of_rpc_polyvar (name_of_polyvar _loc arg)$ -> $accu$ >>) - (<:expr< fun $pid$ -> $create id ctyp$ >>) + (<:expr< fun $pid$ -> $create name id ctyp$ >>) args$ >> diff -r 91091e97839d -r 8e5e1af38c22 rpc-light/rpc.ml --- a/rpc-light/rpc.ml Fri Jan 08 13:47:46 2010 +0000 +++ b/rpc-light/rpc.ml Fri Jan 08 13:47:46 2010 +0000 @@ -12,6 +12,10 @@ * GNU Lesser General Public License for more details. *) +let debug = ref false +let set_debug x = debug := x +let get_debug () = !debug + type t = | Int of int64 | Bool of bool @@ -20,6 +24,9 @@ | Enum of t list | Dict of (string * t) list | Null + +exception Runtime_error of string * t +exception Runtime_exception of string * string open Printf let map_strings sep fn l = String.concat sep (List.map fn l) diff -r 91091e97839d -r 8e5e1af38c22 rpc-light/rpc.mli --- a/rpc-light/rpc.mli Fri Jan 08 13:47:46 2010 +0000 +++ b/rpc-light/rpc.mli Fri Jan 08 13:47:46 2010 +0000 @@ -56,3 +56,12 @@ val success : t -> response val failure : t -> response + +(** {2 Run-time errors} *) + +exception Runtime_error of string * t +exception Runtime_exception of string * string + +(** {2 Debug options} *) +val set_debug : bool -> unit +val get_debug : unit -> bool 3 files changed, 53 insertions(+), 33 deletions(-) rpc-light/p4_rpc.ml | 70 ++++++++++++++++++++++++++------------------------- rpc-light/rpc.ml | 7 +++++ rpc-light/rpc.mli | 9 ++++++
# HG changeset patch # User Thomas Gazagnaire <[email protected]> # Date 1262958466 0 # Node ID 8e5e1af38c22077f98510231918d83ff5c715e05 # Parent 91091e97839df807f73ddbd9ff40ab1e13d7753d [rpc-light] Add some explicit runtime exceptions when an runtime error occurs. A friendly error message is displayed as well if Rpc.set_debug true is called before. Signed-off-by: Thomas Gazagnaire <[email protected]> diff -r 91091e97839d -r 8e5e1af38c22 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 @@ -103,7 +103,6 @@ let new_id_list _loc l = List.split (List.map (fun _ -> new_id _loc) l) -exception Type_not_supported of ctyp let type_not_supported ty = let module PP = Camlp4.Printers.OCaml.Make(Syntax) in let pp = new PP.printer () in @@ -216,121 +215,126 @@ let str_of_id id = match id with <:e...@loc< $lid:s$ >> -> <:e...@loc< $str:s$ >> | _ -> assert false - let runtime_error id expected = + let runtime_error name id expected = let _loc = Loc.ghost in - <:match_case< __x__ -> - failwith (Printf.sprintf "Runtime error while parsing '%s': got '%s' while '%s' was expected\\n" $str_of_id id$ (Rpc.to_string __x__) $str:expected$) + <:match_case< __x__ -> do { + if Rpc.get_debug () then + Printf.eprintf "Runtime error in '%s_of_rpc:%s': got '%s' when '%s' was expected\\n" $str:name$ $str_of_id id$ (Rpc.to_string __x__) $str:expected$ + else (); + raise (Rpc.Runtime_error ($str:expected$, __x__)) } >> - let runtime_exn_error id doing = + let runtime_exn_error name id doing = let _loc = Loc.ghost in - <:match_case< __x__ -> - failwith (Printf.sprintf "Runtime error while parsing '%s': got exception '%s' while doing '%s'\\n" $str_of_id id$ (Printexc.to_string __x__) $str:doing$) - >> + <:match_case< __x__ -> do { + if Rpc.get_debug () then + Printf.eprintf "Runtime error in '%s_of_rpc:%s': caught exception '%s' while doing '%s'\\n" $str:name$ $str_of_id id$ (Printexc.to_string __x__) $str:doing$ + else () ; + raise (Rpc.Runtime_exception ($str:doing$, Printexc.to_string __x__)) } >> - let rec create id ctyp = + let rec create name id ctyp = let _loc = loc_of_ctyp ctyp in match ctyp with - | <:ctyp< unit >> -> <:expr< match $id$ with [ Rpc.Null -> () | $runtime_error id "Null"$ ] >> + | <:ctyp< unit >> -> <:expr< match $id$ with [ Rpc.Null -> () | $runtime_error name id "Null"$ ] >> | <:ctyp< int >> -> <:expr< match $id$ with [ Rpc.Int x -> Int64.to_int x | Rpc.String s -> int_of_string s - | $runtime_error id "Int(int)"$ ] >> + | $runtime_error name id "Int(int)"$ ] >> | <:ctyp< int32 >> -> <:expr< match $id$ with [ Rpc.Int x -> Int64.to_int32 x | Rpc.String s -> Int32.of_string s - | $runtime_error id "Int(int32)"$ ] >> + | $runtime_error name id "Int(int32)"$ ] >> | <:ctyp< int64 >> -> <:expr< match $id$ with [ Rpc.Int x -> x | Rpc.String s -> Int64.of_string s - | $runtime_error id "Int(int64)"$ ] >> + | $runtime_error name id "Int(int64)"$ ] >> | <:ctyp< float >> -> <:expr< match $id$ with [ Rpc.Float x -> x | Rpc.String s -> float_of_string s - | $runtime_error id "Float"$ ] >> + | $runtime_error name id "Float"$ ] >> | <:ctyp< char >> -> <:expr< match $id$ with [ Rpc.Int x -> Char.chr (Int64.to_int x) | Rpc.String s -> Char.chr (int_of_string s) - | $runtime_error id "Int(char)"$ ] >> + | $runtime_error name id "Int(char)"$ ] >> - | <:ctyp< string >> -> <:expr< match $id$ with [ Rpc.String x -> x | $runtime_error id "String(string)"$ ] >> - | <:ctyp< bool >> -> <:expr< match $id$ with [ Rpc.Bool x -> x | $runtime_error id "Bool"$ ] >> + | <:ctyp< string >> -> <:expr< match $id$ with [ Rpc.String x -> x | $runtime_error name id "String(string)"$ ] >> + | <:ctyp< bool >> -> <:expr< match $id$ with [ Rpc.Bool x -> x | $runtime_error name id "Bool"$ ] >> | <:ctyp< [< $t$ ] >> | <:ctyp< [> $t$ ] >> | <:ctyp< [= $t$ ] >> | <:ctyp< [ $t$ ] >> -> 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 exprs = List.map2 create ids ctyps in + let exprs = List.map2 (create name) ids ctyps in let body = List.fold_right (fun a b -> <:expr< $b$ $a$ >>) (List.rev exprs) (if t = `V then <:expr< $uid:n$ >> else <:expr< `$uid:n$ >>) in <:match_case< $patt$ -> $body$ >> in - let fail_match = <:match_case< $runtime_error id "Enum[String s;...]"$ >> in + let fail_match = <:match_case< $runtime_error name id "Enum[String s;...]"$ >> in let patterns = mcOr_of_list (List.map2 pattern ids ctyps @ [ fail_match ]) in <:expr< match $id$ with [ $patterns$ ] >> | <:ctyp< option $t$ >> -> let nid, npid = new_id _loc in - <:expr< match $id$ with [ Rpc.Enum [] -> None | Rpc.Enum [ $npid$ ] -> Some $create nid t$ | $runtime_error id "Enum[]/Enum[_]"$ ] >> + <:expr< match $id$ with [ Rpc.Enum [] -> None | Rpc.Enum [ $npid$ ] -> Some $create name nid t$ | $runtime_error name id "Enum[]/Enum[_]"$ ] >> | <:ctyp< $tup:tp$ >> -> let ctyps = list_of_ctyp tp [] in let ids, pids = new_id_list _loc ctyps in - let exprs = List.map2 create ids ctyps in + let exprs = List.map2 (create name) ids ctyps in <:expr< match $id$ with - [ Rpc.Enum $patt_list_of_list _loc pids$ -> $expr_tuple_of_list _loc exprs$ | $runtime_error id "List"$ ] + [ Rpc.Enum $patt_list_of_list _loc pids$ -> $expr_tuple_of_list _loc exprs$ | $runtime_error name id "List"$ ] >> | <:ctyp< list $t$ >> -> let nid, npid = new_id _loc in let nid2, npid2 = new_id _loc in <:expr< match $id$ with - [ Rpc.Enum $npid$ -> List.map (fun $npid2$ -> $create nid2 t$) $nid$ | $runtime_error id "List"$ ] + [ Rpc.Enum $npid$ -> List.map (fun $npid2$ -> $create name nid2 t$) $nid$ | $runtime_error name id "List"$ ] >> | <:ctyp< array $t$ >> -> let nid, npid = new_id _loc in let nid2, npid2 = new_id _loc in <:expr< match $id$ with - [ Rpc.Enum $npid$ -> Array.of_list (List.map (fun $npid2$ -> $create nid2 t$) $nid$) | $runtime_error id "List"$ ] + [ Rpc.Enum $npid$ -> Array.of_list (List.map (fun $npid2$ -> $create name nid2 t$) $nid$) | $runtime_error name id "List"$ ] >> | <:ctyp< { $t$ } >> -> let nid, npid = new_id _loc in let fields = decompose_fields _loc t in let ids, pids = new_id_list _loc fields in - let exprs = List.map2 (fun id (n, ctyp) -> <:rec_binding< $lid:n$ = $create id ctyp$ >>) ids fields in + let exprs = List.map2 (fun id (n, ctyp) -> <:rec_binding< $lid:n$ = $create name id ctyp$ >>) ids fields in let bindings = List.map2 (fun pid (n, ctyp) -> - <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error nid ("Looking for key "^n)$ ] >> + <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error name nid ("Looking for key "^n)$ ] >> ) pids fields in <:expr< match $id$ with - [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in { $rbSem_of_list exprs$ } | $runtime_error id "Dict"$ ] + [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in { $rbSem_of_list exprs$ } | $runtime_error name id "Dict"$ ] >> | <:ctyp< < $t$ > >> -> let nid, npid = new_id _loc in let fields = decompose_fields _loc t in let ids, pids = new_id_list _loc fields in - let exprs = List.map2 (fun id (n, ctyp) -> <:class_str_item< method $lid:n$ = $create id ctyp$ >>) ids fields in + let exprs = List.map2 (fun id (n, ctyp) -> <:class_str_item< method $lid:n$ = $create name id ctyp$ >>) ids fields in let bindings = List.map2 (fun pid (n, ctyp) -> - <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error nid ("Looking for key "^n)$ ] >> + <:binding< $pid$ = try List.assoc $str:n$ $nid$ with [ $runtime_exn_error name nid ("Looking for key "^n)$ ] >> ) pids fields in <:expr< match $id$ with - [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in object $crSem_of_list exprs$ end | $runtime_error id "Dict"$ ] + [ Rpc.Dict $npid$ -> let $biAnd_of_list bindings$ in object $crSem_of_list exprs$ end | $runtime_error name id "Dict"$ ] >> | <:ctyp< '$lid:a$ >> -> <:expr< $lid:of_rpc_polyvar a$ $id$ >> @@ -338,8 +342,8 @@ | <:ctyp< $lid:t$ >> -> <:expr< $lid:of_rpc t$ $id$ >> | <:ctyp< $id:m$ . $lid:t$ >> -> <:expr< $id:m$ . $lid:of_rpc t$ $id$ >> - | <:ctyp< $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i create id None t a - | <:ctyp< $id:m$ . $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i create id (Some m) t a + | <:ctyp< $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i (create name) id None t a + | <:ctyp< $id:m$ . $lid:t$ $a$ >> -> apply _loc of_rpc of_rpc_i (create name) id (Some m) t a | _ -> type_not_supported ctyp @@ -349,7 +353,7 @@ <:binding< $lid:of_rpc name$ = $List.fold_left (fun accu arg -> <:expr< fun $lid:of_rpc_polyvar (name_of_polyvar _loc arg)$ -> $accu$ >>) - (<:expr< fun $pid$ -> $create id ctyp$ >>) + (<:expr< fun $pid$ -> $create name id ctyp$ >>) args$ >> diff -r 91091e97839d -r 8e5e1af38c22 rpc-light/rpc.ml --- a/rpc-light/rpc.ml Fri Jan 08 13:47:46 2010 +0000 +++ b/rpc-light/rpc.ml Fri Jan 08 13:47:46 2010 +0000 @@ -12,6 +12,10 @@ * GNU Lesser General Public License for more details. *) +let debug = ref false +let set_debug x = debug := x +let get_debug () = !debug + type t = | Int of int64 | Bool of bool @@ -20,6 +24,9 @@ | Enum of t list | Dict of (string * t) list | Null + +exception Runtime_error of string * t +exception Runtime_exception of string * string open Printf let map_strings sep fn l = String.concat sep (List.map fn l) diff -r 91091e97839d -r 8e5e1af38c22 rpc-light/rpc.mli --- a/rpc-light/rpc.mli Fri Jan 08 13:47:46 2010 +0000 +++ b/rpc-light/rpc.mli Fri Jan 08 13:47:46 2010 +0000 @@ -56,3 +56,12 @@ val success : t -> response val failure : t -> response + +(** {2 Run-time errors} *) + +exception Runtime_error of string * t +exception Runtime_exception of string * string + +(** {2 Debug options} *) +val set_debug : bool -> unit +val get_debug : unit -> bool
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
