Autogenerate *Free and *Destroy functions.

3 files changed, 246 insertions, 122 deletions

diff --git a/libvirt/generator.pl b/libvirt/generator.pl
index 40005c0..96ee065 100755
--- a/libvirt/generator.pl
+++ b/libvirt/generator.pl
@@ -29,6 +29,7 @@ use strict;
 # The functions in the libvirt API that we can generate.
 
 my @functions = (
+    { name => "virConnectClose", sig => "conn : free" },
     { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
     { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
     { name => "virConnectGetType", sig => "conn : static string" },
@@ -51,6 +52,8 @@ my @functions = (
       sig => "conn, int : string array", weak => 1 },
     { name => "virConnectGetCapabilities", sig => "conn : string" },
 
+    { name => "virDomainFree", sig => "dom : free" },
+    { name => "virDomainDestroy", sig => "dom : free" },
     { name => "virDomainLookupByName", sig => "conn, string : dom" },
     { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
     { name => "virDomainGetName", sig => "dom : static string" },
@@ -67,6 +70,8 @@ my @functions = (
     { name => "virDomainGetAutostart", sig => "dom : bool" },
     { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
 
+    { name => "virNetworkFree", sig => "net : free" },
+    { name => "virNetworkDestroy", sig => "net : free" },
     { name => "virNetworkLookupByName", sig => "conn, string : net" },
     { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
     { name => "virNetworkGetName", sig => "net : static string" },
@@ -79,6 +84,10 @@ my @functions = (
     { name => "virNetworkGetAutostart", sig => "net : bool" },
     { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
 
+    { name => "virStoragePoolFree",
+      sig => "pool : free", weak => 1 },
+    { name => "virStoragePoolDestroy",
+      sig => "pool : free", weak => 1 },
     { name => "virStoragePoolLookupByName",
       sig => "conn, string : pool", weak => 1 },
     { name => "virStoragePoolLookupByUUIDString",
@@ -104,6 +113,8 @@ my @functions = (
     { name => "virStoragePoolSetAutostart",
       sig => "pool, bool : unit", weak => 1 },
 
+    { name => "virStorageVolFree", sig => "vol : free" },
+    { name => "virStorageVolDestroy", sig => "vol : free" },
 #    { name => "virStorageVolLookupByName", XXX see libvir-list posting
 #      sig => "pool, string : vol", weak => 1 },
     { name => "virStorageVolLookupByKey",
@@ -134,14 +145,10 @@ my @unimplemented = (
     "ocaml_libvirt_network_create_job",
     "ocaml_libvirt_network_create_xml_job",
     "ocaml_libvirt_storage_pool_get_info",
-    "ocaml_libvirt_storage_pool_free", #?
-    "ocaml_libvirt_storage_pool_destroy", #?
     "ocaml_libvirt_storage_pool_define_xml",
     "ocaml_libvirt_storage_pool_create_xml",
     "ocaml_libvirt_storage_pool_lookup_by_uuid",
     "ocaml_libvirt_storage_vol_lookup_by_name", # XXX
-    "ocaml_libvirt_storage_vol_free", #?
-    "ocaml_libvirt_storage_vol_destroy", #?
     "ocaml_libvirt_storage_vol_create_xml",
     "ocaml_libvirt_storage_vol_get_info",
     "ocaml_libvirt_pool_of_volume",
@@ -281,6 +288,9 @@ sub gen_c_signature
     } elsif ($sig =~ /^(\w+) : unit$/) {
 	my $c_type = short_name_to_c_type ($1);
 	"int $c_name ($c_type $1)"
+    } elsif ($sig =~ /^(\w+) : free$/) {
+	my $c_type = short_name_to_c_type ($1);
+	"int $c_name ($c_type $1)"
     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 	my $c_type = short_name_to_c_type ($1);
 	my $c_ret_type = short_name_to_c_type ($2);
@@ -318,6 +328,8 @@ sub gen_arg_names
 	( "$1v" )
     } elsif ($sig =~ /^(\w+) : unit$/) {
 	( "$1v" )
+    } elsif ($sig =~ /^(\w+) : free$/) {
+	( "$1v" )
     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 	( "$1v", "strv" )
     } else {
@@ -352,14 +364,26 @@ sub gen_pack_result
 {
     local $_ = shift;
 
-    if ($_ eq "dom") {
-	"rv = Val_domain (r, connv);"
-    } elsif ($_ eq "net") {
-	"rv = Val_network (r, connv);"
-    } elsif ($_ eq "pool") {
-	"rv = Val_pool (r, connv);"
-    } elsif ($_ eq "vol") {
-	"rv = Val_volume (r, connv);"
+    if ($_ eq "dom") {     "rv = Val_domain (r, connv);" }
+    elsif ($_ eq "net") {  "rv = Val_network (r, connv);" }
+    elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
+    elsif ($_ eq "vol") {  "rv = Val_volume (r, connv);" }
+    else {
+	die "unknown short name $_"
+    }
+}
+
+sub gen_free_arg
+{
+    local $_ = shift;
+
+    if ($_ eq "conn") {     "Connect_val (connv) = NULL;" }
+    elsif ($_ eq "dom") {   "Domain_val (domv) = NULL;" }
+    elsif ($_ eq "net") {   "Network_val (netv) = NULL;" }
+    elsif ($_ eq "pool") {  "Pool_val (poolv) = NULL;" }
+    elsif ($_ eq "vol") {   "Volume_val (volv) = NULL;" }
+    else {
+	die "unknown short name $_"
     }
 }
 
@@ -500,6 +524,16 @@ sub gen_c_code
   free (r);
   CAMLreturn (rv);
 "
+    } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
+	"\
+  " . gen_unpack_args ($1) . "
+  int r;
+
+  NONBLOCKING (r = $c_name ($1, 0));
+  CHECK_ERROR (r == -1, conn, \"$c_name\");
+
+  CAMLreturn (Val_unit);
+"
     } elsif ($sig =~ /^(\w+) : unit$/) {
 	"\
   " . gen_unpack_args ($1) . "
@@ -510,14 +544,17 @@ sub gen_c_code
 
   CAMLreturn (Val_unit);
 "
-    } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
+    } elsif ($sig =~ /^(\w+) : free$/) {
 	"\
   " . gen_unpack_args ($1) . "
   int r;
 
-  NONBLOCKING (r = $c_name ($1, 0));
+  NONBLOCKING (r = $c_name ($1));
   CHECK_ERROR (r == -1, conn, \"$c_name\");
 
+  /* So that we don't double-free in the finalizer: */
+  " . gen_free_arg ($1) . "
+
   CAMLreturn (Val_unit);
 "
     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c
index 8c31710..a23efbd 100644
--- a/libvirt/libvirt_c.c
+++ b/libvirt/libvirt_c.c
@@ -47,6 +47,23 @@
 
 #include "libvirt_c_oneoffs.c"
 
+CAMLprim value
+ocaml_libvirt_connect_close (value connv)
+{
+  CAMLparam1 (connv);
+
+  virConnectPtr conn = Connect_val (connv);
+  int r;
+
+  NONBLOCKING (r = virConnectClose (conn));
+  CHECK_ERROR (r == -1, conn, "virConnectClose");
+
+  /* So that we don't double-free in the finalizer: */
+  Connect_val (connv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
 #ifdef HAVE_WEAK_SYMBOLS
 #ifdef HAVE_VIRCONNECTGETHOSTNAME
 extern char *virConnectGetHostname (virConnectPtr conn) __attribute__((weak));
@@ -441,6 +458,42 @@ ocaml_libvirt_connect_get_capabilities (value connv)
 }
 
 CAMLprim value
+ocaml_libvirt_domain_free (value domv)
+{
+  CAMLparam1 (domv);
+
+  virDomainPtr dom = Domain_val (domv);
+  virConnectPtr conn = Connect_domv (domv);
+  int r;
+
+  NONBLOCKING (r = virDomainFree (dom));
+  CHECK_ERROR (r == -1, conn, "virDomainFree");
+
+  /* So that we don't double-free in the finalizer: */
+  Domain_val (domv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+ocaml_libvirt_domain_destroy (value domv)
+{
+  CAMLparam1 (domv);
+
+  virDomainPtr dom = Domain_val (domv);
+  virConnectPtr conn = Connect_domv (domv);
+  int r;
+
+  NONBLOCKING (r = virDomainDestroy (dom));
+  CHECK_ERROR (r == -1, conn, "virDomainDestroy");
+
+  /* So that we don't double-free in the finalizer: */
+  Domain_val (domv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
 ocaml_libvirt_domain_lookup_by_name (value connv, value strv)
 {
   CAMLparam2 (connv, strv);
@@ -688,6 +741,42 @@ ocaml_libvirt_domain_set_autostart (value domv, value bv)
 }
 
 CAMLprim value
+ocaml_libvirt_network_free (value netv)
+{
+  CAMLparam1 (netv);
+
+  virNetworkPtr net = Network_val (netv);
+  virConnectPtr conn = Connect_netv (netv);
+  int r;
+
+  NONBLOCKING (r = virNetworkFree (net));
+  CHECK_ERROR (r == -1, conn, "virNetworkFree");
+
+  /* So that we don't double-free in the finalizer: */
+  Network_val (netv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+ocaml_libvirt_network_destroy (value netv)
+{
+  CAMLparam1 (netv);
+
+  virNetworkPtr net = Network_val (netv);
+  virConnectPtr conn = Connect_netv (netv);
+  int r;
+
+  NONBLOCKING (r = virNetworkDestroy (net));
+  CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
+
+  /* So that we don't double-free in the finalizer: */
+  Network_val (netv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
 ocaml_libvirt_network_lookup_by_name (value connv, value strv)
 {
   CAMLparam2 (connv, strv);
@@ -875,6 +964,76 @@ ocaml_libvirt_network_set_autostart (value netv, value bv)
 }
 
 #ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRSTORAGEPOOLFREE
+extern int virStoragePoolFree (virStoragePoolPtr pool) __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_storage_pool_free (value poolv)
+{
+  CAMLparam1 (poolv);
+#ifndef HAVE_VIRSTORAGEPOOLFREE
+  /* Symbol virStoragePoolFree not found at compile time. */
+  not_supported ("virStoragePoolFree");
+  /* Suppresses a compiler warning. */
+  (void) caml__frame;
+#else
+  /* Check that the symbol virStoragePoolFree
+   * is in runtime version of libvirt.
+   */
+  WEAK_SYMBOL_CHECK (virStoragePoolFree);
+
+  virStoragePoolPtr pool = Pool_val (poolv);
+  virConnectPtr conn = Connect_polv (poolv);
+  int r;
+
+  NONBLOCKING (r = virStoragePoolFree (pool));
+  CHECK_ERROR (r == -1, conn, "virStoragePoolFree");
+
+  /* So that we don't double-free in the finalizer: */
+  Pool_val (poolv) = NULL;
+
+  CAMLreturn (Val_unit);
+#endif
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRSTORAGEPOOLDESTROY
+extern int virStoragePoolDestroy (virStoragePoolPtr pool) __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_storage_pool_destroy (value poolv)
+{
+  CAMLparam1 (poolv);
+#ifndef HAVE_VIRSTORAGEPOOLDESTROY
+  /* Symbol virStoragePoolDestroy not found at compile time. */
+  not_supported ("virStoragePoolDestroy");
+  /* Suppresses a compiler warning. */
+  (void) caml__frame;
+#else
+  /* Check that the symbol virStoragePoolDestroy
+   * is in runtime version of libvirt.
+   */
+  WEAK_SYMBOL_CHECK (virStoragePoolDestroy);
+
+  virStoragePoolPtr pool = Pool_val (poolv);
+  virConnectPtr conn = Connect_polv (poolv);
+  int r;
+
+  NONBLOCKING (r = virStoragePoolDestroy (pool));
+  CHECK_ERROR (r == -1, conn, "virStoragePoolDestroy");
+
+  /* So that we don't double-free in the finalizer: */
+  Pool_val (poolv) = NULL;
+
+  CAMLreturn (Val_unit);
+#endif
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
 #ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME
 extern virStoragePoolPtr virStoragePoolLookupByName (virConnectPtr conn, const char *str) __attribute__((weak));
 #endif
@@ -1277,6 +1436,42 @@ ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv)
 #endif
 }
 
+CAMLprim value
+ocaml_libvirt_storage_vol_free (value volv)
+{
+  CAMLparam1 (volv);
+
+  virStorageVolPtr vol = Volume_val (volv);
+  virConnectPtr conn = Connect_volv (volv);
+  int r;
+
+  NONBLOCKING (r = virStorageVolFree (vol));
+  CHECK_ERROR (r == -1, conn, "virStorageVolFree");
+
+  /* So that we don't double-free in the finalizer: */
+  Volume_val (volv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+ocaml_libvirt_storage_vol_destroy (value volv)
+{
+  CAMLparam1 (volv);
+
+  virStorageVolPtr vol = Volume_val (volv);
+  virConnectPtr conn = Connect_volv (volv);
+  int r;
+
+  NONBLOCKING (r = virStorageVolDestroy (vol));
+  CHECK_ERROR (r == -1, conn, "virStorageVolDestroy");
+
+  /* So that we don't double-free in the finalizer: */
+  Volume_val (volv) = NULL;
+
+  CAMLreturn (Val_unit);
+}
+
 #ifdef HAVE_WEAK_SYMBOLS
 #ifdef HAVE_VIRSTORAGEVOLLOOKUPBYKEY
 extern virStorageVolPtr virStorageVolLookupByKey (virConnectPtr conn, const char *str) __attribute__((weak));
@@ -1538,18 +1733,6 @@ ocaml_libvirt_storage_pool_get_info ()
 }
 
 CAMLprim value
-ocaml_libvirt_storage_pool_free ()
-{
-  failwith ("ocaml_libvirt_storage_pool_free is unimplemented");
-}
-
-CAMLprim value
-ocaml_libvirt_storage_pool_destroy ()
-{
-  failwith ("ocaml_libvirt_storage_pool_destroy is unimplemented");
-}
-
-CAMLprim value
 ocaml_libvirt_storage_pool_define_xml ()
 {
   failwith ("ocaml_libvirt_storage_pool_define_xml is unimplemented");
@@ -1574,18 +1757,6 @@ ocaml_libvirt_storage_vol_lookup_by_name ()
 }
 
 CAMLprim value
-ocaml_libvirt_storage_vol_free ()
-{
-  failwith ("ocaml_libvirt_storage_vol_free is unimplemented");
-}
-
-CAMLprim value
-ocaml_libvirt_storage_vol_destroy ()
-{
-  failwith ("ocaml_libvirt_storage_vol_destroy is unimplemented");
-}
-
-CAMLprim value
 ocaml_libvirt_storage_vol_create_xml ()
 {
   failwith ("ocaml_libvirt_storage_vol_create_xml is unimplemented");
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 27f917d..0d568d6 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -127,22 +127,6 @@ ocaml_libvirt_connect_open_readonly (value namev, value unit)
 }
 
 CAMLprim value
-ocaml_libvirt_connect_close (value connv)
-{
-  CAMLparam1 (connv);
-  virConnectPtr conn = Connect_val (connv);
-  int r;
-
-  NONBLOCKING (r = virConnectClose (conn));
-  CHECK_ERROR (r == -1, conn, "virConnectClose");
-
-  /* So that we don't double-free in the finalizer: */
-  Connect_val (connv) = NULL;
-
-  CAMLreturn (Val_unit);
-}
-
-CAMLprim value
 ocaml_libvirt_connect_get_version (value connv)
 {
   CAMLparam1 (connv);
@@ -293,40 +277,6 @@ ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
 }
 
 CAMLprim value
-ocaml_libvirt_domain_destroy (value domv)
-{
-  CAMLparam1 (domv);
-  virDomainPtr dom = Domain_val (domv);
-  virConnectPtr conn = Connect_domv (domv);
-  int r;
-
-  NONBLOCKING (r = virDomainDestroy (dom));
-  CHECK_ERROR (r == -1, conn, "virDomainDestroy");
-
-  /* So that we don't double-free in the finalizer: */
-  Domain_val (domv) = NULL;
-
-  CAMLreturn (Val_unit);
-}
-
-CAMLprim value
-ocaml_libvirt_domain_free (value domv)
-{
-  CAMLparam1 (domv);
-  virDomainPtr dom = Domain_val (domv);
-  virConnectPtr conn = Connect_domv (domv);
-  int r;
-
-  NONBLOCKING (r = virDomainFree (dom));
-  CHECK_ERROR (r == -1, conn, "virDomainFree");
-
-  /* So that we don't double-free in the finalizer: */
-  Domain_val (domv) = NULL;
-
-  CAMLreturn (Val_unit);
-}
-
-CAMLprim value
 ocaml_libvirt_domain_save (value domv, value pathv)
 {
   CAMLparam2 (domv, pathv);
@@ -889,40 +839,6 @@ ocaml_libvirt_network_define_xml (value connv, value xmlv)
   CAMLreturn (rv);
 }
 
-CAMLprim value
-ocaml_libvirt_network_destroy (value netv)
-{
-  CAMLparam1 (netv);
-  virNetworkPtr net = Network_val (netv);
-  virConnectPtr conn = Connect_netv (netv);
-  int r;
-
-  NONBLOCKING (r = virNetworkDestroy (net));
-  CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
-
-  /* So that we don't double-free in the finalizer: */
-  Network_val (netv) = NULL;
-
-  CAMLreturn (Val_unit);
-}
-
-CAMLprim value
-ocaml_libvirt_network_free (value netv)
-{
-  CAMLparam1 (netv);
-  virNetworkPtr net = Network_val (netv);
-  virConnectPtr conn = Connect_netv (netv);
-  int r;
-
-  NONBLOCKING (r = virNetworkFree (net));
-  CHECK_ERROR (r == -1, conn, "virNetworkFree");
-
-  /* So that we don't double-free in the finalizer: */
-  Network_val (netv) = NULL;
-
-  CAMLreturn (Val_unit);
-}
-
 /*----------------------------------------------------------------------*/
 
 CAMLprim value