127 lines
3.4 KiB
Diff
127 lines
3.4 KiB
Diff
From e26c6904d9f9f5ea818e590331b14038279332d1 Mon Sep 17 00:00:00 2001
|
|
From: Father Chrysostomos <sprout@cpan.org>
|
|
Date: Sun, 25 Jun 2017 06:37:19 -0700
|
|
Subject: [PATCH] [perl #131645] Fix assert fail in pp_sselect
|
|
MIME-Version: 1.0
|
|
Content-Type: text/plain; charset=UTF-8
|
|
Content-Transfer-Encoding: 8bit
|
|
|
|
pp_sselect (4-arg select) process its first three bitfield arguments
|
|
first, making sure each one has a valid PV, and then it moves on to
|
|
the final, timeout argument.
|
|
|
|
SvGETMAGIC() on the timeout argument will wipe out any values the SV
|
|
holds, so if the same scalar is used as a bitfield argument *and* as
|
|
the timeout, it will no longer hold a valid PV.
|
|
|
|
Assertions later in pp_sselect make sure there is a valid PV.
|
|
|
|
This commit solves the assertion failure by making a temporary copy of
|
|
any gmagical or overloaded argument. When the temporary copy is made,
|
|
the values written to the temporary copies of the bitfield arguments
|
|
are then copied back to the original magical arguments.
|
|
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
---
|
|
pp_sys.c | 21 +++++++++++++++------
|
|
t/op/sselect.t | 11 ++++++++++-
|
|
2 files changed, 25 insertions(+), 7 deletions(-)
|
|
|
|
diff --git a/pp_sys.c b/pp_sys.c
|
|
index 65900fa..100762c 100644
|
|
--- a/pp_sys.c
|
|
+++ b/pp_sys.c
|
|
@@ -1149,6 +1149,7 @@ PP(pp_sselect)
|
|
struct timeval *tbuf = &timebuf;
|
|
I32 growsize;
|
|
char *fd_sets[4];
|
|
+ SV *svs[4];
|
|
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
|
|
I32 masksize;
|
|
I32 offset;
|
|
@@ -1164,7 +1165,7 @@ PP(pp_sselect)
|
|
|
|
SP -= 4;
|
|
for (i = 1; i <= 3; i++) {
|
|
- SV * const sv = SP[i];
|
|
+ SV * const sv = svs[i] = SP[i];
|
|
SvGETMAGIC(sv);
|
|
if (!SvOK(sv))
|
|
continue;
|
|
@@ -1177,9 +1178,14 @@ PP(pp_sselect)
|
|
if (!SvPOKp(sv))
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
|
|
"Non-string passed as bitmask");
|
|
- SvPV_force_nomg_nolen(sv); /* force string conversion */
|
|
+ if (SvGAMAGIC(sv)) {
|
|
+ svs[i] = sv_newmortal();
|
|
+ sv_copypv_nomg(svs[i], sv);
|
|
+ }
|
|
+ else
|
|
+ SvPV_force_nomg_nolen(sv); /* force string conversion */
|
|
}
|
|
- j = SvCUR(sv);
|
|
+ j = SvCUR(svs[i]);
|
|
if (maxlen < j)
|
|
maxlen = j;
|
|
}
|
|
@@ -1228,7 +1234,7 @@ PP(pp_sselect)
|
|
tbuf = NULL;
|
|
|
|
for (i = 1; i <= 3; i++) {
|
|
- sv = SP[i];
|
|
+ sv = svs[i];
|
|
if (!SvOK(sv) || SvCUR(sv) == 0) {
|
|
fd_sets[i] = 0;
|
|
continue;
|
|
@@ -1275,7 +1281,7 @@ PP(pp_sselect)
|
|
#endif
|
|
for (i = 1; i <= 3; i++) {
|
|
if (fd_sets[i]) {
|
|
- sv = SP[i];
|
|
+ sv = svs[i];
|
|
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
|
|
s = SvPVX(sv);
|
|
for (offset = 0; offset < growsize; offset += masksize) {
|
|
@@ -1284,7 +1290,10 @@ PP(pp_sselect)
|
|
}
|
|
Safefree(fd_sets[i]);
|
|
#endif
|
|
- SvSETMAGIC(sv);
|
|
+ if (sv != SP[i])
|
|
+ SvSetMagicSV(SP[i], sv);
|
|
+ else
|
|
+ SvSETMAGIC(sv);
|
|
}
|
|
}
|
|
|
|
diff --git a/t/op/sselect.t b/t/op/sselect.t
|
|
index fedbfc7..9ec1c63 100644
|
|
--- a/t/op/sselect.t
|
|
+++ b/t/op/sselect.t
|
|
@@ -13,7 +13,7 @@ BEGIN {
|
|
skip_all("Win32 miniperl has no socket select")
|
|
if $^O eq "MSWin32" && is_miniperl();
|
|
|
|
-plan (15);
|
|
+plan (16);
|
|
|
|
my $blank = "";
|
|
eval {select undef, $blank, $blank, 0};
|
|
@@ -95,3 +95,12 @@ note("diff=$diff under=$under");
|
|
select (undef, undef, undef, $sleep);
|
|
::is($count, 1, 'RT120102');
|
|
}
|
|
+
|
|
+package _131645{
|
|
+ sub TIESCALAR { bless [] }
|
|
+ sub FETCH { 0 }
|
|
+ sub STORE { }
|
|
+}
|
|
+tie $tie, _131645::;
|
|
+select ($tie, undef, undef, $tie);
|
|
+ok("no crash from select $numeric_tie, undef, undef, $numeric_tie")
|
|
--
|
|
2.9.4
|
|
|