Package: perl
Version: 5.14.2-21
Severity: important
Tags: patch
Dear Maintainer,
I reported this bug on the perl bug tracker:
https://rt.perl.org/rt3/Public/Bug/Display.html?id=117885
I discovered it was fixed in perl 5.16 so I bisected it and found out which
commit fix the problem.
Please find attached the patches of the git commit fixing it.
-- System Information:
Debian Release: 7.0
APT prefers stable
APT policy: (500, 'stable'), (1, 'experimental')
Architecture: i386 (i686)
Kernel: Linux 3.2.0-3-486
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)
Shell: /bin/sh linked to /bin/dash
Versions of packages perl depends on:
ii libbz2-1.0 1.0.6-4
ii libc6 2.13-38
ii libdb5.1 5.1.29-5
ii libgdbm3 1.8.3-11
ii perl-base 5.14.2-21
ii perl-modules 5.14.2-21
ii zlib1g 1:1.2.7.dfsg-13
Versions of packages perl recommends:
ii netbase 5.0
Versions of packages perl suggests:
pn libterm-readline-gnu-perl | libterm-readline-perl-perl <none>
ii make 3.81-8.2
pn perl-doc <none>
>From 342f0eda56f3ef8fe29d43f50534cc03175774ef Mon Sep 17 00:00:00 2001
From: Nicholas Clark <n...@ccl4.org>
Date: Wed, 7 Sep 2011 13:15:04 +0200
Subject: [PATCH 1/3] Store struct termios used by POSIX::Termios directly in the object SV.
Previously POSIX::Termios was using the PTROBJ typemap to store a pointer to
a dynamically-allocated struct termios as an IV (blessed into the class).
This requires an explicit DESTROY to free the dynamic allocation, but fails
badly if any POSIX::Termios objects exist at ithread clone time, as the
dynamic allocation is not duplicated in the new thread. (DESTROY is called
in both threads, free-from-wrong pool or other jollity occurs.)
Removing dynamic allocation removes the need for a DESTROY method.
This introduces a new OPAQUEPTROBJ typemap, but currently doesn't use the
OUTPUT section, as that copies an existing structure, whereas
POSIX::Termios->new() only needs to zero-allocate the right space. Assuming
that this typemap should be of general applicability, it should be moved to
the main typemap file.
---
ext/POSIX/POSIX.xs | 28 +++++++++++++---------------
ext/POSIX/typemap | 16 +++++++++++++++-
2 files changed, 28 insertions(+), 16 deletions(-)
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 8dc1f5a..0675dc2 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -715,30 +715,28 @@ sigismember(sigset, sig)
MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
-POSIX::Termios
+void
new(packname = "POSIX::Termios", ...)
const char * packname
CODE:
{
#ifdef I_TERMIOS
- Newx(RETVAL, 1, struct termios);
+ SV *t;
+ ST(0) = sv_newmortal();
+ t = newSVrv(ST(0), packname);
+ sv_grow(t, sizeof(struct termios) + 1);
+ SvCUR_set(t, sizeof(struct termios));
+ SvPOK_on(t);
+ /* The previous implementation stored a pointer to an uninitialised
+ struct termios. Seems safer to initialise it, particularly as
+ this implementation exposes the struct to prying from perl-space.
+ */
+ memset(SvPVX(t), 0, 1 + sizeof(struct termios));
+ XSRETURN(1);
#else
not_here("termios");
- RETVAL = 0;
#endif
}
- OUTPUT:
- RETVAL
-
-void
-DESTROY(termios_ref)
- POSIX::Termios termios_ref
- CODE:
-#ifdef I_TERMIOS
- Safefree(termios_ref);
-#else
- not_here("termios");
-#endif
SysRet
getattr(termios_ref, fd = 0)
diff --git a/ext/POSIX/typemap b/ext/POSIX/typemap
index d54d5d1..b283099 100644
--- a/ext/POSIX/typemap
+++ b/ext/POSIX/typemap
@@ -12,5 +12,19 @@ speed_t T_IV
tcflag_t T_IV
cc_t T_IV
POSIX::SigSet T_PTROBJ
-POSIX::Termios T_PTROBJ
+POSIX::Termios T_OPAQUEPTROBJ
POSIX::SigAction T_HVREF
+
+INPUT
+T_OPAQUEPTROBJ
+ if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
+ $var = ($type)SvPV_nolen(SvRV($arg));
+ }
+ else
+ Perl_croak(aTHX_ \"%s: %s is not of type %s\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+ \"$var\", \"$ntype\")
+
+OUTPUT
+T_OPAQUEPTROBJ
+ sv_setref_pvn($arg, \"${ntype}\", (const char*)$var, sizeof(*$var));
--
1.7.2.5
>From 0ea9614344efd5f0a28b93bcf892e1502cce1614 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <n...@ccl4.org>
Date: Wed, 7 Sep 2011 16:57:03 +0200
Subject: [PATCH 2/3] In POSIX.xs, extract allocate_struct() from POSIX::Termios::new().
The same code will be needed for POSIX::SigSet::new(), so share it as a small
static function.
---
ext/POSIX/POSIX.xs | 20 +++++++++++++-------
1 files changed, 13 insertions(+), 7 deletions(-)
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 0675dc2..549c9c5 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -558,6 +558,16 @@ restore_sigmask(pTHX_ SV *osset_sv)
(void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
}
+static void *
+allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
+ SV *const t = newSVrv(rv, packname);
+ void *const p = sv_grow(t, size + 1);
+
+ SvCUR_set(t, size);
+ SvPOK_on(t);
+ return p;
+}
+
#ifdef WIN32
/*
@@ -721,17 +731,13 @@ new(packname = "POSIX::Termios", ...)
CODE:
{
#ifdef I_TERMIOS
- SV *t;
- ST(0) = sv_newmortal();
- t = newSVrv(ST(0), packname);
- sv_grow(t, sizeof(struct termios) + 1);
- SvCUR_set(t, sizeof(struct termios));
- SvPOK_on(t);
+ void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
+ sizeof(struct termios), packname);
/* The previous implementation stored a pointer to an uninitialised
struct termios. Seems safer to initialise it, particularly as
this implementation exposes the struct to prying from perl-space.
*/
- memset(SvPVX(t), 0, 1 + sizeof(struct termios));
+ memset(p, 0, 1 + sizeof(struct termios));
XSRETURN(1);
#else
not_here("termios");
--
1.7.2.5
>From f62389dc35ad960c92ad755de5c1a453d4100c43 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <n...@ccl4.org>
Date: Wed, 7 Sep 2011 18:52:36 +0200
Subject: [PATCH 3/3] Store sigset_t used by POSIX::SigSet directly in the object SV.
Previously POSIX::SigSet was using the PTROBJ typemap to store a pointer to
a dynamically-allocated sigset_t as an IV (blessed into the class)
This requires an explicit DESTROY to free the dynamic allocation, but fails
badly if any POSIX::SigSet objects exist at ithread clone time, as the
dynamic allocation is not duplicated in the new thread. (DESTROY is called
in both threads, free-from-wrong pool or other jollity occurs.)
Removing dynamic allocation removes the need for a DESTROY method.
This change is analogous to the previous change in POSIX::Termios, and is
made for the same reason.
---
ext/POSIX/POSIX.xs | 37 +++++++++++++++----------------------
ext/POSIX/typemap | 2 +-
2 files changed, 16 insertions(+), 23 deletions(-)
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 549c9c5..48b800f 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -680,25 +680,21 @@ my_tzset(pTHX)
MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
-POSIX::SigSet
+void
new(packname = "POSIX::SigSet", ...)
const char * packname
CODE:
{
int i;
- Newx(RETVAL, 1, sigset_t);
- sigemptyset(RETVAL);
+ sigset_t *const s
+ = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
+ sizeof(sigset_t),
+ packname);
+ sigemptyset(s);
for (i = 1; i < items; i++)
- sigaddset(RETVAL, SvIV(ST(i)));
+ sigaddset(s, SvIV(ST(i)));
+ XSRETURN(1);
}
- OUTPUT:
- RETVAL
-
-void
-DESTROY(sigset)
- POSIX::SigSet sigset
- CODE:
- Safefree(sigset);
SysRet
sigaddset(sigset, sig)
@@ -1463,12 +1459,12 @@ sigaction(sig, optaction, oldaction = 0)
/* Get back the mask. */
svp = hv_fetchs(oldaction, "MASK", TRUE);
if (sv_isa(*svp, "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(*svp));
- sigset = INT2PTR(sigset_t*, tmp);
+ sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
}
else {
- Newx(sigset, 1, sigset_t);
- sv_setptrobj(*svp, sigset, "POSIX::SigSet");
+ sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
+ sizeof(sigset_t),
+ "POSIX::SigSet");
}
*sigset = oact.sa_mask;
@@ -1522,8 +1518,7 @@ sigaction(sig, optaction, oldaction = 0)
/* Set up any desired mask. */
svp = hv_fetchs(action, "MASK", FALSE);
if (svp && sv_isa(*svp, "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(*svp));
- sigset = INT2PTR(sigset_t*, tmp);
+ sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
act.sa_mask = *sigset;
}
else
@@ -1564,8 +1559,7 @@ INIT:
if (! SvOK(ST(1))) {
sigset = NULL;
} else if (sv_isa(ST(1), "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(ST(1)));
- sigset = INT2PTR(POSIX__SigSet,tmp);
+ sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
} else {
croak("sigset is not of type POSIX::SigSet");
}
@@ -1573,8 +1567,7 @@ INIT:
if (items < 3 || ! SvOK(ST(2))) {
oldsigset = NULL;
} else if (sv_isa(ST(2), "POSIX::SigSet")) {
- IV tmp = SvIV((SV*)SvRV(ST(2)));
- oldsigset = INT2PTR(POSIX__SigSet,tmp);
+ oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
} else {
croak("oldsigset is not of type POSIX::SigSet");
}
diff --git a/ext/POSIX/typemap b/ext/POSIX/typemap
index b283099..e6a82dc 100644
--- a/ext/POSIX/typemap
+++ b/ext/POSIX/typemap
@@ -11,7 +11,7 @@ fd T_IV
speed_t T_IV
tcflag_t T_IV
cc_t T_IV
-POSIX::SigSet T_PTROBJ
+POSIX::SigSet T_OPAQUEPTROBJ
POSIX::Termios T_OPAQUEPTROBJ
POSIX::SigAction T_HVREF
--
1.7.2.5
