java: Fix optional arguments in calls.
[libguestfs.git] / generator / generator_java.ml
index 2ccb1b6..4d51c53 100644 (file)
@@ -1,5 +1,5 @@
 (* libguestfs
- * Copyright (C) 2009-2010 Red Hat Inc.
+ * Copyright (C) 2009-2011 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -37,6 +37,7 @@ let rec generate_java_java () =
 package com.redhat.et.libguestfs;
 
 import java.util.HashMap;
+import java.util.Map;
 import com.redhat.et.libguestfs.LibGuestFSException;
 import com.redhat.et.libguestfs.PV;
 import com.redhat.et.libguestfs.VG;
@@ -100,10 +101,14 @@ public class GuestFS {
 ";
 
   List.iter (
-    fun (name, style, _, flags, _, shortdesc, longdesc) ->
+    fun (name, (ret, args, optargs as style), _, flags, _, shortdesc, longdesc) ->
       if not (List.mem NotInDocs flags); then (
         let doc = replace_str longdesc "C<guestfs_" "C<g." in
         let doc =
+          if optargs <> [] then
+            doc ^ "\n\nOptional arguments are supplied in the final Map<String,Object> parameter, which is a hash of the argument name to its value (cast to Object).  Pass an empty Map or null for no optional arguments."
+          else doc in
+        let doc =
           if List.mem ProtocolLimitWarning flags then
             doc ^ "\n\n" ^ protocol_limit_warning
           else doc in
@@ -129,20 +134,61 @@ public class GuestFS {
         pr "   * %s\n" doc;
         pr "   * @throws LibGuestFSException\n";
         pr "   */\n";
-        pr "  ";
       );
+      pr "  ";
       generate_java_prototype ~public:true ~semicolon:false name style;
       pr "\n";
       pr "  {\n";
       pr "    if (g == 0)\n";
       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
         name;
-      pr "    ";
-      if fst style <> RErr then pr "return ";
-      pr "_%s " name;
-      generate_java_call_args ~handle:"g" (snd style);
-      pr ";\n";
+      if optargs <> [] then (
+        pr "\n";
+        pr "    /* Unpack optional args. */\n";
+        pr "    Object _optobj;\n";
+        pr "    long _optargs_bitmask = 0;\n";
+        iteri (
+          fun i argt ->
+            let t, boxed_t, convert, n, default =
+              match argt with
+              | Bool n -> "boolean", "Boolean", ".booleanValue()", n, "false"
+              | Int n -> "int", "Integer", ".intValue()", n, "0"
+              | Int64 n -> "long", "Long", ".longValue()", n, "0"
+              | String n -> "String", "String", "", n, "\"\""
+              | _ -> assert false in
+            pr "    %s %s = %s;\n" t n default;
+            pr "    _optobj = null;\n";
+            pr "    if (optargs != null)\n";
+            pr "      _optobj = optargs.get (\"%s\");\n" n;
+            pr "    if (_optobj != null) {\n";
+            pr "      %s = ((%s) _optobj)%s;\n" n boxed_t convert;
+            pr "      _optargs_bitmask |= %Ld;\n"
+              (Int64.shift_left Int64.one i);
+            pr "    }\n";
+        ) optargs
+      );
+      pr "\n";
+      (match ret with
+       | RErr ->
+           pr "    _%s " name;
+           generate_java_call_args ~handle:"g" style;
+           pr ";\n"
+       | RHashtable _ ->
+           pr "    String[] r = _%s " name;
+           generate_java_call_args ~handle:"g" style;
+           pr ";\n";
+           pr "\n";
+           pr "    HashMap rhash = new HashMap ();\n";
+           pr "    for (int i = 0; i < r.length; i += 2)\n";
+           pr "      rhash.put (r[i], r[i+1]);\n";
+           pr "    return rhash;\n"
+       | _ ->
+           pr "    return _%s " name;
+           generate_java_call_args ~handle:"g" style;
+           pr ";\n"
+      );
       pr "  }\n";
+      pr "\n";
       pr "  ";
       generate_java_prototype ~privat:true ~native:true name style;
       pr "\n";
@@ -152,19 +198,23 @@ public class GuestFS {
   pr "}\n"
 
 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
-and generate_java_call_args ~handle args =
+and generate_java_call_args ~handle (_, args, optargs) =
   pr "(%s" handle;
   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
+  if optargs <> [] then (
+    pr ", _optargs_bitmask";
+    List.iter (fun arg -> pr ", %s" (name_of_argt arg)) optargs
+  );
   pr ")"
 
 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
-    ?(semicolon=true) name style =
+    ?(semicolon=true) name (ret, args, optargs) =
   if privat then pr "private ";
   if public then pr "public ";
   if native then pr "native ";
 
   (* return type *)
-  (match fst style with
+  (match ret with
    | RErr -> pr "void ";
    | RInt _ -> pr "int ";
    | RInt64 _ -> pr "long ";
@@ -178,7 +228,11 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
    | RStructList (_, typ) ->
        let name = java_name_of_struct typ in
        pr "%s[] " name;
-   | RHashtable _ -> pr "HashMap<String,String> ";
+   | RHashtable _ ->
+       if not native then
+         pr "Map<String,String> "
+       else
+         pr "String[] ";
   );
 
   if native then pr "_%s " name else pr "%s " name;
@@ -212,9 +266,29 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
           pr "boolean %s" n
       | Int n ->
           pr "int %s" n
-      | Int64 n ->
+      | Int64 n | Pointer (_, n) ->
           pr "long %s" n
-  ) (snd style);
+  ) args;
+
+  if optargs <> [] then (
+    if !needs_comma then pr ", ";
+    needs_comma := true;
+
+    if not native then
+      pr "Map<String, Object> optargs"
+    else (
+      pr "long _optargs_bitmask";
+      List.iter (
+        fun argt ->
+          match argt with
+          | Bool n -> pr ", boolean %s" n
+          | Int n -> pr ", int %s" n
+          | Int64 n -> pr ", long %s" n
+          | String n -> pr ", String %s" n
+          | _ -> assert false
+      ) optargs
+    )
+  );
 
   pr ")\n";
   pr "    throws LibGuestFSException";
@@ -299,9 +373,9 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
 ";
 
   List.iter (
-    fun (name, style, _, _, _, _, _) ->
+    fun (name, (ret, args, optargs as style), _, _, _, _, _) ->
       pr "JNIEXPORT ";
-      (match fst style with
+      (match ret with
        | RErr -> pr "void ";
        | RInt _ -> pr "jint ";
        | RInt64 _ -> pr "jlong ";
@@ -336,46 +410,57 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
             pr ", jboolean j%s" n
         | Int n ->
             pr ", jint j%s" n
-        | Int64 n ->
+        | Int64 n | Pointer (_, n) ->
             pr ", jlong j%s" n
-      ) (snd style);
+      ) args;
+      if optargs <> [] then (
+        pr ", jlong joptargs_bitmask";
+        List.iter (
+          function
+          | Bool n -> pr ", jboolean j%s" n
+          | Int n -> pr ", jint j%s" n
+          | Int64 n -> pr ", jlong j%s" n
+          | String n -> pr ", jstring j%s" n
+          | _ -> assert false
+        ) optargs
+      );
       pr ")\n";
       pr "{\n";
       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
-      let error_code, no_ret =
-        match fst style with
-        | RErr -> pr "  int r;\n"; "-1", ""
-        | RBool _
-        | RInt _ -> pr "  int r;\n"; "-1", "0"
-        | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
-        | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
-        | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
-        | RString _ ->
-            pr "  jstring jr;\n";
-            pr "  char *r;\n"; "NULL", "NULL"
-        | RStringList _ ->
-            pr "  jobjectArray jr;\n";
-            pr "  int r_len;\n";
-            pr "  jclass cl;\n";
-            pr "  jstring jstr;\n";
-            pr "  char **r;\n"; "NULL", "NULL"
-        | RStruct (_, typ) ->
-            pr "  jobject jr;\n";
-            pr "  jclass cl;\n";
-            pr "  jfieldID fl;\n";
-            pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
-        | RStructList (_, typ) ->
-            pr "  jobjectArray jr;\n";
-            pr "  jclass cl;\n";
-            pr "  jfieldID fl;\n";
-            pr "  jobject jfl;\n";
-            pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
-        | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
-        | RBufferOut _ ->
-            pr "  jstring jr;\n";
-            pr "  char *r;\n";
-            pr "  size_t size;\n";
-            "NULL", "NULL" in
+      (match ret with
+       | RErr -> pr "  int r;\n"
+       | RBool _
+       | RInt _ -> pr "  int r;\n"
+       | RInt64 _ -> pr "  int64_t r;\n"
+       | RConstString _ -> pr "  const char *r;\n"
+       | RConstOptString _ -> pr "  const char *r;\n"
+       | RString _ ->
+           pr "  jstring jr;\n";
+           pr "  char *r;\n"
+       | RStringList _
+       | RHashtable _ ->
+           pr "  jobjectArray jr;\n";
+           pr "  size_t r_len;\n";
+           pr "  jclass cl;\n";
+           pr "  jstring jstr;\n";
+           pr "  char **r;\n"
+       | RStruct (_, typ) ->
+           pr "  jobject jr;\n";
+           pr "  jclass cl;\n";
+           pr "  jfieldID fl;\n";
+           pr "  struct guestfs_%s *r;\n" typ
+       | RStructList (_, typ) ->
+           pr "  jobjectArray jr;\n";
+           pr "  jclass cl;\n";
+           pr "  jfieldID fl;\n";
+           pr "  jobject jfl;\n";
+           pr "  struct guestfs_%s_list *r;\n" typ
+       | RBufferOut _ ->
+           pr "  jstring jr;\n";
+           pr "  char *r;\n";
+           pr "  size_t size;\n"
+      );
+
       List.iter (
         function
         | Pathname n
@@ -387,28 +472,30 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
         | Key n ->
             pr "  const char *%s;\n" n
         | BufferIn n ->
-            pr "  jbyte *%s;\n" n;
+            pr "  char *%s;\n" n;
             pr "  size_t %s_size;\n" n
         | StringList n | DeviceList n ->
-            pr "  int %s_len;\n" n;
-            pr "  const char **%s;\n" n
+            pr "  size_t %s_len;\n" n;
+            pr "  char **%s;\n" n
         | Bool n
         | Int n ->
             pr "  int %s;\n" n
         | Int64 n ->
             pr "  int64_t %s;\n" n
-      ) (snd style);
+        | Pointer (t, n) ->
+            pr "  %s %s;\n" t n
+      ) args;
 
       let needs_i =
-        (match fst style with
-         | RStringList _ | RStructList _ -> true
+        (match ret with
+         | RStringList _ | RStructList _ | RHashtable _ -> true
          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
          | RConstOptString _
-         | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
+         | RString _ | RBufferOut _ | RStruct _ -> false) ||
           List.exists (function
                        | StringList _ -> true
                        | DeviceList _ -> true
-                       | _ -> false) (snd style) in
+                       | _ -> false) args in
       if needs_i then
         pr "  size_t i;\n";
 
@@ -430,7 +517,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
              *)
             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
         | BufferIn n ->
-            pr "  %s = (*env)->GetByteArrayElements (env, j%s, NULL);\n" n n;
+            pr "  %s = (char *) (*env)->GetByteArrayElements (env, j%s, NULL);\n" n n;
             pr "  %s_size = (*env)->GetArrayLength (env, j%s);\n" n n
         | StringList n | DeviceList n ->
             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
@@ -438,17 +525,39 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
               n;
-            pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
+            pr "    %s[i] = (char *) (*env)->GetStringUTFChars (env, o, NULL);\n" n;
             pr "  }\n";
             pr "  %s[%s_len] = NULL;\n" n n;
         | Bool n
         | Int n
         | Int64 n ->
             pr "  %s = j%s;\n" n n
-      ) (snd style);
+        | Pointer (t, n) ->
+            pr "  %s = (%s) j%s;\n" n t n
+      ) args;
+
+      if optargs <> [] then (
+        pr "  struct guestfs_%s_argv optargs_s;\n" name;
+        pr "  const struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
+        pr "  optargs_s.bitmask = joptargs_bitmask;\n";
+        List.iter (
+          function
+          | Bool n
+          | Int n
+          | Int64 n ->
+              pr "  optargs_s.%s = j%s;\n" n n
+          | String n ->
+              pr "  optargs_s.%s = (*env)->GetStringUTFChars (env, j%s, NULL);\n"
+                n n
+          | _ -> assert false
+        ) optargs;
+      );
 
       (* Make the call. *)
-      pr "  r = guestfs_%s " name;
+      if optargs = [] then
+        pr "  r = guestfs_%s " name
+      else
+        pr "  r = guestfs_%s_argv " name;
       generate_c_call_args ~handle:"g" style;
       pr ";\n";
 
@@ -466,7 +575,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
             pr "  if (j%s)\n" n;
             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
         | BufferIn n ->
-            pr "  (*env)->ReleaseByteArrayElements (env, j%s, %s, 0);\n" n n
+            pr "  (*env)->ReleaseByteArrayElements (env, j%s, (jbyte *) %s, 0);\n" n n
         | StringList n | DeviceList n ->
             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
@@ -474,19 +583,51 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
             pr "  }\n";
             pr "  free (%s);\n" n
+        | Bool _
+        | Int _
+        | Int64 _
+        | Pointer _ -> ()
+      ) args;
+
+      List.iter (
+        function
         | Bool n
         | Int n
         | Int64 n -> ()
-      ) (snd style);
+        | String n ->
+            pr "  (*env)->ReleaseStringUTFChars (env, j%s, optargs_s.%s);\n" n n
+        | _ -> assert false
+      ) optargs;
 
       (* Check for errors. *)
-      pr "  if (r == %s) {\n" error_code;
-      pr "    throw_exception (env, guestfs_last_error (g));\n";
-      pr "    return %s;\n" no_ret;
-      pr "  }\n";
+      (match errcode_of_ret ret with
+       | `CannotReturnError -> ()
+       | (`ErrorIsMinusOne|`ErrorIsNULL) as errcode ->
+           (match errcode with
+            | `ErrorIsMinusOne ->
+                pr "  if (r == -1) {\n";
+            | `ErrorIsNULL ->
+                pr "  if (r == NULL) {\n";
+           );
+           pr "    throw_exception (env, guestfs_last_error (g));\n";
+           (match ret with
+            | RErr ->
+                pr "    return;\n"
+            | RInt _
+            | RInt64 _
+            | RBool _ ->
+                pr "    return -1;\n"
+            | RConstString _ | RConstOptString _ | RString _
+            | RBufferOut _
+            | RStruct _ | RHashtable _
+            | RStringList _ | RStructList _ ->
+                pr "    return NULL;\n"
+           );
+           pr "  }\n"
+      );
 
       (* Return value. *)
-      (match fst style with
+      (match ret with
        | RErr -> ()
        | RInt _ -> pr "  return (jint) r;\n"
        | RBool _ -> pr "  return (jboolean) r;\n"
@@ -498,7 +639,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
            pr "  jr = (*env)->NewStringUTF (env, r);\n";
            pr "  free (r);\n";
            pr "  return jr;\n"
-       | RStringList _ ->
+       | RStringList _
+       | RHashtable _ ->
            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
@@ -518,12 +660,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
            let jtyp = java_name_of_struct typ in
            let cols = cols_of_struct typ in
            generate_java_struct_list_return typ jtyp cols
-       | RHashtable _ ->
-           (* XXX *)
-           pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
-           pr "  return NULL;\n"
        | RBufferOut _ ->
-           pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
+           pr "  jr = (*env)->NewStringUTF (env, r); // XXX size\n";
            pr "  free (r);\n";
            pr "  return jr;\n"
       );