Patch subject is complete summary.
ocaml/idl/ocaml_backend/genOCaml.ml | 6 +++--- ocaml/idl/ocaml_backend/gen_api.ml | 32 +++++++++++++++++++------------- 2 files changed, 22 insertions(+), 16 deletions(-)
# HG changeset patch # User Rok Strnisa <[email protected]> # Date 1286297215 -3600 # Node ID acc630b1c4284faf145cdb4c8df7a47fa2a0ccbf # Parent 5206bae8148494f1c3fe06f31eef8bce0df7b613 imported patch better-backtracing-for-xml-parsing diff --git a/ocaml/idl/ocaml_backend/genOCaml.ml b/ocaml/idl/ocaml_backend/genOCaml.ml --- a/ocaml/idl/ocaml_backend/genOCaml.ml +++ b/ocaml/idl/ocaml_backend/genOCaml.ml @@ -101,7 +101,7 @@ let gen_to_xmlrpc api tys = block (** Generate code to marshal from the given datamodel type to XML-RPC. *) let ty_of_xmlrpc api ty = let alias_of_ty_param t = "("^(alias_of_ty t)^" param)" in - let wrap var_binding b = "fun " ^ var_binding ^ " -> try ("^b^") with _ -> raise (Api_errors.Server_error (Api_errors.field_type_error,[param]))" in + let wrap var_binding b = "fun " ^ var_binding ^ " -> try ("^b^") with _ -> log_backtrace (); raise (Api_errors.Server_error (Api_errors.field_type_error,[param]))" in let f = match ty with | Bool -> wrap "xml" "From.boolean xml" | DateTime -> wrap "xml" "From.datetime xml" @@ -110,7 +110,7 @@ let ty_of_xmlrpc api ty = wrap "xml" ("\n match String.lowercase (From.string xml) with\n "^ String.concat "\n | " (List.map aux cs)^ - "\n | _ -> raise (RunTimeTypeError(\""^name^"\", xml))") + "\n | _ -> log_backtrace(); raise (RunTimeTypeError(\""^name^"\", xml))") | Float -> wrap "xml" "From.double xml" | Int -> wrap "xml" "Int64.of_string(From.string xml)" | Map(key, value) -> @@ -147,7 +147,7 @@ let ty_of_xmlrpc api ty = DT.Set (DT.Ref _) -> Some (DT.VSet []) | _ -> fld.DT.default_value in match default_value with - None -> "(my_assoc \"" ^ field_name ^ "\" all)" + None -> "(my_assoc \"" ^ field_name ^ "\" all)" | Some default -> Printf.sprintf "(if (List.mem_assoc \"%s\" all) then (my_assoc \"%s\" all) else %s)" field_name field_name diff --git a/ocaml/idl/ocaml_backend/gen_api.ml b/ocaml/idl/ocaml_backend/gen_api.ml --- a/ocaml/idl/ocaml_backend/gen_api.ml +++ b/ocaml/idl/ocaml_backend/gen_api.ml @@ -35,7 +35,7 @@ let gen_type highapi = function | ty -> [ "and "^OU.alias_of_ty ty^" = "^OU.ocaml_of_ty ty ] let gen_client highapi = - let all_types = DU.Types.of_objects (Dm_api.objects_of_api highapi) in + let _ (* unused variable: all_types *) = DU.Types.of_objects (Dm_api.objects_of_api highapi) in List.iter (List.iter print) (List.between [""] [[ "open Xml"; @@ -49,20 +49,26 @@ let gen_client highapi = ]) let gen_client_types highapi = - let all_types = DU.Types.of_objects (Dm_api.objects_of_api highapi) in - List.iter (List.iter print) - (List.between [""] - [[ "open Xml"; - "open XMLRPC"; - "open Date"; ]; - "type __unused = unit " :: (List.concat (List.map (gen_type highapi) all_types)); - GenOCaml.gen_of_xmlrpc highapi all_types; - GenOCaml.gen_to_xmlrpc highapi all_types; - O.Signature.strings_of (Gen_client.gen_signature highapi); - ]) + let all_types = DU.Types.of_objects (Dm_api.objects_of_api highapi) in + List.iter (List.iter print) + (List.between [""] + [ + [ + "open Xml"; + "open XMLRPC"; + "open Date"; + "module D = Debug.Debugger(struct let name = \"backtrace\" end)"; + "open D" + ]; + "type __unused = unit " :: (List.concat (List.map (gen_type highapi) all_types)); + GenOCaml.gen_of_xmlrpc highapi all_types; + GenOCaml.gen_to_xmlrpc highapi all_types; + O.Signature.strings_of (Gen_client.gen_signature highapi); + ] + ) let gen_server highapi = - let all_types = DU.Types.of_objects (Dm_api.objects_of_api highapi) in + let _ (* Unused variable: all_types *) = DU.Types.of_objects (Dm_api.objects_of_api highapi) in List.iter (List.iter print) (List.between [""] [[ "open Xml";
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
