Improved backtracing of some of the exceptions thrown within the xml parsing

code.

Signed-off-by: Rok Strnisa <rok.strnisa@citrix.com>

diff --git a/ocaml/idl/ocaml_backend/genOCaml.ml b/ocaml/idl/ocaml_backend/genOCaml.ml
index e12b4c6deaf56ba94cf47101b3115621a85515ef..af80b041ec76286fa958ecde00c2b7413644d34f 100644 (file)
--- 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
index 57b7ecc71659d5a9176ceb4eae5e69e13010c0a0..39171e3cb0d6bdc784ab3f82759d55c1e41d180e 100644 (file)
--- 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";