X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=generator%2Fgenerator_ocaml.ml;h=ced6fb428360d99a403eefb2806f4ff1d9d8e358;hb=880374c6df2a694bb1457231f110d9ef7035e5b7;hp=888a15274ecf02e90b2bdd103873e0756c682eaa;hpb=14490c3e1aac61c6ac90f28828896683f64f0dc9;p=libguestfs.git

diff --git a/generator/generator_ocaml.ml b/generator/generator_ocaml.ml
index 888a152..ced6fb4 100644
--- a/generator/generator_ocaml.ml
+++ b/generator/generator_ocaml.ml
@@ -198,6 +198,7 @@ and generate_ocaml_c () =
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#include <stdint.h>
 
 #include <caml/config.h>
 #include <caml/alloc.h>
@@ -400,6 +401,8 @@ copy_table (char * const * argv)
             pr "  int %s = Int_val (%sv);\n" n n
         | Int64 n ->
             pr "  int64_t %s = Int64_val (%sv);\n" n n
+        | Pointer (t, n) ->
+            pr "  %s %s = (%s) (intptr_t) Int64_val (%sv);\n" t n t n
       ) args;
 
       (* Optional arguments. *)
@@ -427,31 +430,28 @@ copy_table (char * const * argv)
         ) optargs
       );
 
-      let error_code =
-        match ret with
-        | RErr -> pr "  int r;\n"; "-1"
-        | RInt _ -> pr "  int r;\n"; "-1"
-        | RInt64 _ -> pr "  int64_t r;\n"; "-1"
-        | RBool _ -> pr "  int r;\n"; "-1"
-        | RConstString _ | RConstOptString _ ->
-            pr "  const char *r;\n"; "NULL"
-        | RString _ -> pr "  char *r;\n"; "NULL"
-        | RStringList _ ->
-            pr "  size_t i;\n";
-            pr "  char **r;\n";
-            "NULL"
-        | RStruct (_, typ) ->
-            pr "  struct guestfs_%s *r;\n" typ; "NULL"
-        | RStructList (_, typ) ->
-            pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
-        | RHashtable _ ->
-            pr "  size_t i;\n";
-            pr "  char **r;\n";
-            "NULL"
-        | RBufferOut _ ->
-            pr "  char *r;\n";
-            pr "  size_t size;\n";
-            "NULL" in
+      (match ret with
+       | RErr -> pr "  int r;\n"
+       | RInt _ -> pr "  int r;\n"
+       | RInt64 _ -> pr "  int64_t r;\n"
+       | RBool _ -> pr "  int r;\n"
+       | RConstString _ | RConstOptString _ ->
+           pr "  const char *r;\n"
+       | RString _ -> pr "  char *r;\n"
+       | RStringList _ ->
+           pr "  size_t i;\n";
+           pr "  char **r;\n"
+       | RStruct (_, typ) ->
+           pr "  struct guestfs_%s *r;\n" typ
+       | RStructList (_, typ) ->
+           pr "  struct guestfs_%s_list *r;\n" typ
+       | RHashtable _ ->
+           pr "  size_t i;\n";
+           pr "  char **r;\n"
+       | RBufferOut _ ->
+           pr "  char *r;\n";
+           pr "  size_t size;\n"
+      );
       pr "\n";
 
       pr "  caml_enter_blocking_section ();\n";
@@ -471,7 +471,7 @@ copy_table (char * const * argv)
             pr "  free (%s);\n" n
         | StringList n | DeviceList n ->
             pr "  ocaml_guestfs_free_strings (%s);\n" n;
-        | Bool _ | Int _ | Int64 _ -> ()
+        | Bool _ | Int _ | Int64 _ | Pointer _ -> ()
       ) args;
       List.iter (
         function
@@ -481,11 +481,18 @@ copy_table (char * const * argv)
         | Bool _ | Int _ | Int64 _
         | Pathname _ | Device _ | Dev_or_Path _ | OptString _
         | FileIn _ | FileOut _ | BufferIn _ | Key _
-        | StringList _ | DeviceList _ -> ()
+        | StringList _ | DeviceList _ | Pointer _ -> ()
       ) optargs;
 
-      pr "  if (r == %s)\n" error_code;
-      pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
+      (match errcode_of_ret ret with
+       | `CannotReturnError -> ()
+       | `ErrorIsMinusOne ->
+           pr "  if (r == -1)\n";
+           pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
+       | `ErrorIsNULL ->
+           pr "  if (r == NULL)\n";
+           pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
+      );
       pr "\n";
 
       (match ret with
@@ -534,7 +541,8 @@ copy_table (char * const * argv)
         pr "CAMLprim value ";
         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
         pr "CAMLprim value\n";
-        pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
+        pr "ocaml_guestfs_%s_byte (value *argv, int argn ATTRIBUTE_UNUSED)\n"
+          name;
         pr "{\n";
         pr "  return ocaml_guestfs_%s (argv[0]" name;
         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
@@ -592,7 +600,7 @@ and generate_ocaml_function_type (ret, args, optargs) =
     | StringList _ | DeviceList _ -> pr "string array -> "
     | Bool _ -> pr "bool -> "
     | Int _ -> pr "int -> "
-    | Int64 _ -> pr "int64 -> "
+    | Int64 _ | Pointer _ -> pr "int64 -> "
   ) args;
   (match ret with
    | RErr -> pr "unit" (* all errors are turned into exceptions *)