From ca75b55ec25f8ae3463702f16cdeb95ebde2916a Mon Sep 17 00:00:00 2001 From: Richard Jones Date: Fri, 10 Jul 2009 12:06:11 +0100 Subject: [PATCH] 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. --- src/generator.ml | 49 ++++++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 23 deletions(-) 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 -- 1.8.3.1