Add upstream patch to fix Perl bindtests on 32 bit.
This commit is contained in:
parent
05fade033b
commit
eb4d3df8f6
106
0001-perl-bindtests-Fix-64-bit-integers-on-input-on-32-bi.patch
Normal file
106
0001-perl-bindtests-Fix-64-bit-integers-on-input-on-32-bi.patch
Normal file
@ -0,0 +1,106 @@
|
|||||||
|
From 1aca7053db3208d307ff2e43bd414d728a1edcc1 Mon Sep 17 00:00:00 2001
|
||||||
|
From: "Richard W.M. Jones" <rjones@redhat.com>
|
||||||
|
Date: Wed, 29 Aug 2012 10:31:09 +0100
|
||||||
|
Subject: [PATCH] perl: bindtests: Fix 64 bit integers on input on 32 bit Perl
|
||||||
|
interpreter.
|
||||||
|
|
||||||
|
---
|
||||||
|
generator/generator_bindtests.ml | 4 ++--
|
||||||
|
generator/generator_perl.ml | 27 +++++++++++++++++++++++++--
|
||||||
|
perl/typemap | 5 ++++-
|
||||||
|
3 files changed, 31 insertions(+), 5 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/generator/generator_bindtests.ml b/generator/generator_bindtests.ml
|
||||||
|
index 95577c0..54c46fa 100644
|
||||||
|
--- a/generator/generator_bindtests.ml
|
||||||
|
+++ b/generator/generator_bindtests.ml
|
||||||
|
@@ -370,7 +370,7 @@ my $g = Sys::Guestfs->new ();
|
||||||
|
| CallStringList xs ->
|
||||||
|
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
|
||||||
|
| CallInt i -> string_of_int i
|
||||||
|
- | CallInt64 i -> Int64.to_string i
|
||||||
|
+ | CallInt64 i -> "\"" ^ Int64.to_string i ^ "\""
|
||||||
|
| CallBool b -> if b then "1" else "0"
|
||||||
|
| CallBuffer s -> "\"" ^ c_quote s ^ "\""
|
||||||
|
) args
|
||||||
|
@@ -379,7 +379,7 @@ my $g = Sys::Guestfs->new ();
|
||||||
|
function
|
||||||
|
| CallOBool (n, v) -> "'" ^ n ^ "' => " ^ if v then "1" else "0"
|
||||||
|
| CallOInt (n, v) -> "'" ^ n ^ "' => " ^ string_of_int v
|
||||||
|
- | CallOInt64 (n, v) -> "'" ^ n ^ "' => " ^ Int64.to_string v
|
||||||
|
+ | CallOInt64 (n, v) -> "'" ^ n ^ "' => \"" ^ Int64.to_string v ^ "\""
|
||||||
|
| CallOString (n, v) -> "'" ^ n ^ "' => '" ^ v ^ "'"
|
||||||
|
| CallOStringList (n, xs) ->
|
||||||
|
"'" ^ n ^ "' => " ^
|
||||||
|
diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml
|
||||||
|
index 3ed521f..07644e8 100644
|
||||||
|
--- a/generator/generator_perl.ml
|
||||||
|
+++ b/generator/generator_perl.ml
|
||||||
|
@@ -75,6 +75,28 @@ my_newSVull(unsigned long long val) {
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
+/* Convert a 64 bit int on input. To cope with the case of having
|
||||||
|
+ * a 32 bit Perl interpreter, we allow the user to pass a string
|
||||||
|
+ * here which is scanned as a 64 bit integer.
|
||||||
|
+ */
|
||||||
|
+static int64_t
|
||||||
|
+my_SvIV64 (SV *sv)
|
||||||
|
+{
|
||||||
|
+#ifdef USE_64_BIT_ALL
|
||||||
|
+ return SvIV (sv);
|
||||||
|
+#else
|
||||||
|
+ if (SvTYPE (sv) == SVt_PV) {
|
||||||
|
+ const char *str = SvPV_nolen (sv);
|
||||||
|
+ int64_t r;
|
||||||
|
+
|
||||||
|
+ sscanf (str, \"%%\" SCNi64, &r);
|
||||||
|
+ return r;
|
||||||
|
+ }
|
||||||
|
+ else
|
||||||
|
+ return SvIV (sv);
|
||||||
|
+#endif
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
/* http://www.perlmonks.org/?node_id=680842 */
|
||||||
|
static char **
|
||||||
|
XS_unpack_charPtrPtr (SV *arg) {
|
||||||
|
@@ -419,9 +441,10 @@ user_cancel (g)
|
||||||
|
pr "if (strcmp (this_arg, \"%s\") == 0) {\n" n;
|
||||||
|
(match argt with
|
||||||
|
| OBool _
|
||||||
|
- | OInt _
|
||||||
|
- | OInt64 _ ->
|
||||||
|
+ | OInt _ ->
|
||||||
|
pr " optargs_s.%s = SvIV (ST (items_i+1));\n" n;
|
||||||
|
+ | OInt64 _ ->
|
||||||
|
+ pr " optargs_s.%s = my_SvIV64 (ST (items_i+1));\n" n;
|
||||||
|
| OString _ ->
|
||||||
|
pr " optargs_s.%s = SvPV_nolen (ST (items_i+1));\n" n;
|
||||||
|
| OStringList _ ->
|
||||||
|
diff --git a/perl/typemap b/perl/typemap
|
||||||
|
index d978e60..43e7948 100644
|
||||||
|
--- a/perl/typemap
|
||||||
|
+++ b/perl/typemap
|
||||||
|
@@ -2,7 +2,7 @@ TYPEMAP
|
||||||
|
char * T_PV
|
||||||
|
const char * T_PV
|
||||||
|
guestfs_h * O_OBJECT_guestfs_h
|
||||||
|
-int64_t T_IV
|
||||||
|
+int64_t O_OBJECT_int64
|
||||||
|
|
||||||
|
INPUT
|
||||||
|
O_OBJECT_guestfs_h
|
||||||
|
@@ -18,6 +18,9 @@ O_OBJECT_guestfs_h
|
||||||
|
croak (\"${Package}::$func_name(): $var is not a blessed HV reference\");
|
||||||
|
}
|
||||||
|
|
||||||
|
+O_OBJECT_int64
|
||||||
|
+ $var = my_SvIV64 ($arg);
|
||||||
|
+
|
||||||
|
OUTPUT
|
||||||
|
O_OBJECT_guestfs_h
|
||||||
|
sv_setiv ($arg, PTR2IV ($var));
|
||||||
|
--
|
||||||
|
1.7.11.5
|
||||||
|
|
@ -22,7 +22,7 @@ Summary: Access and modify virtual machine disk images
|
|||||||
Name: libguestfs
|
Name: libguestfs
|
||||||
Epoch: 1
|
Epoch: 1
|
||||||
Version: 1.19.34
|
Version: 1.19.34
|
||||||
Release: 1%{?dist}
|
Release: 2%{?dist}
|
||||||
License: LGPLv2+
|
License: LGPLv2+
|
||||||
Group: Development/Libraries
|
Group: Development/Libraries
|
||||||
URL: http://libguestfs.org/
|
URL: http://libguestfs.org/
|
||||||
@ -33,6 +33,9 @@ Patch1: ruby-1.9-vendor-not-site.patch
|
|||||||
BuildRequires: autoconf, automake, libtool, gettext-devel
|
BuildRequires: autoconf, automake, libtool, gettext-devel
|
||||||
%endif
|
%endif
|
||||||
|
|
||||||
|
# Upstream patch to fix Perl bindtests on 32 bit.
|
||||||
|
Patch2: 0001-perl-bindtests-Fix-64-bit-integers-on-input-on-32-bi.patch
|
||||||
|
|
||||||
# Non-upstream patch to remove udev from the packagelist. systemd now
|
# Non-upstream patch to remove udev from the packagelist. systemd now
|
||||||
# 'obsoletes' udev, but febootstrap doesn't get this relationship
|
# 'obsoletes' udev, but febootstrap doesn't get this relationship
|
||||||
# right. When udev disappears from the repository we can remove this
|
# right. When udev disappears from the repository we can remove this
|
||||||
@ -678,6 +681,8 @@ for %{name}.
|
|||||||
autoreconf -i
|
autoreconf -i
|
||||||
%endif
|
%endif
|
||||||
|
|
||||||
|
%patch2 -p1
|
||||||
|
|
||||||
%patch4 -p1
|
%patch4 -p1
|
||||||
|
|
||||||
mkdir -p daemon/m4
|
mkdir -p daemon/m4
|
||||||
@ -991,6 +996,9 @@ mkdir -p $RPM_BUILD_ROOT%{_localstatedir}/run/libguestfs
|
|||||||
|
|
||||||
|
|
||||||
%changelog
|
%changelog
|
||||||
|
* Wed Aug 29 2012 Richard W.M. Jones <rjones@redhat.com> - 1:1.19.34-2
|
||||||
|
- Add upstream patch to fix Perl bindtests on 32 bit.
|
||||||
|
|
||||||
* Tue Aug 28 2012 Richard W.M. Jones <rjones@redhat.com> - 1:1.19.34-1
|
* Tue Aug 28 2012 Richard W.M. Jones <rjones@redhat.com> - 1:1.19.34-1
|
||||||
- New upstream version 1.19.34.
|
- New upstream version 1.19.34.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user