diff options
author | Richard Jones <rjones@trick.home.annexia.org> | 2009-07-10 12:06:11 +0100 |
---|---|---|
committer | Richard Jones <rjones@trick.home.annexia.org> | 2009-07-10 12:06:11 +0100 |
commit | ca75b55ec25f8ae3463702f16cdeb95ebde2916a (patch) | |
tree | 23a2857828c1f7e102415fa8e72c391e39e1501a /src | |
parent | 0fc6b7affd28ad77566e832f338650b771145ea1 (diff) | |
download | libguestfs-ca75b55ec25f8ae3463702f16cdeb95ebde2916a.tar.gz libguestfs-ca75b55ec25f8ae3463702f16cdeb95ebde2916a.tar.xz libguestfs-ca75b55ec25f8ae3463702f16cdeb95ebde2916a.zip |
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.
Diffstat (limited to 'src')
-rwxr-xr-x | src/generator.ml | 49 |
1 files changed, 26 insertions, 23 deletions
diff --git a/src/generator.ml b/src/generator.ml index d94ec146..7c0e5662 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 |