From: Richard Jones <rjones@trick.home.annexia.org>
Date: Fri, 10 Jul 2009 11:06:11 +0000 (+0100)
Subject: Fix for returning structures (hashes) from Perl calls.
X-Git-Tag: 1.0.57~5
X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=commitdiff_plain;h=ca75b55ec25f8ae3463702f16cdeb95ebde2916a

Fix for returning structures (hashes) from Perl calls.

Calls such as stat and statvfs which returned a single structure
were returning an array of values instead of a full hash of keys +
values.

Fix this by pushing the key names on the stack too.
---

diff --git a/src/generator.ml b/src/generator.ml
index d94ec14..7c0e566 100755
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -6048,30 +6048,33 @@ and generate_perl_struct_code typ cols name style n do_cleanups =
   do_cleanups ();
   pr "      if (%s == NULL)\n" n;
   pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
-  pr "      EXTEND (SP, %d);\n" (List.length cols);
+  pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
   List.iter (
-    function
-    | name, FString ->
-	pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
-	  n name
-    | name, FUUID ->
-	pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
-	  n name
-    | name, (FBytes|FUInt64) ->
-	pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
-	  n name
-    | name, FInt64 ->
-	pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
-	  n name
-    | name, (FInt32|FUInt32) ->
-	pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
-	  n name
-    | name, FChar ->
-	pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
-	  n name
-    | name, FOptPercent ->
-	pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
-	  n name
+    fun ((name, _) as col) ->
+      pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
+
+      match col with
+      | name, FString ->
+	  pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
+	    n name
+      | name, FUUID ->
+	  pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
+	    n name
+      | name, (FBytes|FUInt64) ->
+	  pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
+	    n name
+      | name, FInt64 ->
+	  pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
+	    n name
+      | name, (FInt32|FUInt32) ->
+	  pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+	    n name
+      | name, FChar ->
+	  pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
+	    n name
+      | name, FOptPercent ->
+	  pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+	    n name
   ) cols;
   pr "      free (%s);\n" n