In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/c7bd8b847014f9a4cd5fa4bcf968ab4a8e11d2fe?hp=644ac3a877e810ca7c69833b568049c1c2665ce9>
- Log -----------------------------------------------------------------
commit c7bd8b847014f9a4cd5fa4bcf968ab4a8e11d2fe
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 2 06:17:36 2012 -0700
Donât leak when printf causes wide warnings
M pp_sys.c
M t/op/svleak.t
commit 104c40b089b35a27c011188bbe19b03f1150c54c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 2 06:12:27 2012 -0700
Donât leak when printfing to bad handle under fatal warnings
M pp_sys.c
M t/op/svleak.t
commit 4a608acc6005c3f6abb2284d7bf50732d400aa71
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 2 05:59:31 2012 -0700
concat2.t: Under miniperl only skip one test
M t/op/concat2.t
commit 583a5589b0727e1fccd2f9f7f0c8cb50c04884d5
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 2 05:48:34 2012 -0700
Fix $byte_overload .= $utf8 regression
This is a regression from 5.12.
This was probably broken by commit c5aa287237.
#!perl -lCS
{ package o; use overload '""' => sub { $_[0][0] } }
$x = bless[chr 256],o::;
"$x";
$x->[0] = "\xff";
$x.= chr 257;
$x.= chr 257;
use Devel::Peek;
Dump $x;
print $x;
__END__
Output under 5.12.4:
SV = PVIV(0x820604) at 0x825820
REFCNT = 1
FLAGS = (POK,pPOK,UTF8)
IV = 0
PV = 0x2139d0 "\303\277\304\201\304\201"\0 [UTF8 "\x{ff}\x{101}\x{101}"]
CUR = 6
LEN = 16
ÿÄÄ
Output under 5.14.0:
SV = PVIV(0x820604) at 0x826490
REFCNT = 1
FLAGS = (POK,pPOK,UTF8)
IV = 0
PV = 0x316230 "\303\277\303\204\302\201\304\201"\0 [UTF8
"\x{ff}\x{c4}\x{81}\x{101}"]
CUR = 8
LEN = 16
ÿÃÂÄ
The UTF8 flag is only meaningful right after stringification.
If the $byte_overload scalar happens to have the flag on from last
time, but string overloading will turn the flag off, then pp_concat
gets confused as to whether it is dealing with bytes or utf8. It
sees both sides as having the same utf8ness, so it concatenates,
which stringifies the lhs and turns off the flag. The utf8 sequences
appended end up with no utf8 flag associated with them, the observable
effect being that the rhs is encoded as utf8.
If it werenât for encoding.pm, we could use sv_catpvn_nomg_maybeutf8
and avoid determining the utf8ness of the lhs beforehand. But see-
ing that encoding.pm still exists, we have to prevent double overload
stringification the other way, by force-stringification of the target.
M pp_hot.c
M t/op/concat2.t
-----------------------------------------------------------------------
Summary of changes:
pp_hot.c | 4 ++--
pp_sys.c | 5 +----
t/op/concat2.t | 15 +++++++++++++--
t/op/svleak.t | 15 ++++++++++++++-
4 files changed, 30 insertions(+), 9 deletions(-)
diff --git a/pp_hot.c b/pp_hot.c
index 868240b..a1c9579 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -273,8 +273,8 @@ PP(pp_concat)
report_uninit(right);
sv_setpvs(left, "");
}
- lbyte = (SvROK(left) && SvTYPE(SvRV(left)) == SVt_REGEXP)
- ? !DO_UTF8(SvRV(left)) : !DO_UTF8(left);
+ SvPV_force_nomg_nolen(left);
+ lbyte = !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
}
diff --git a/pp_sys.c b/pp_sys.c
index bb82e32..3a034b3 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1515,7 +1515,6 @@ PP(pp_prtf)
{
dVAR; dSP; dMARK; dORIGMARK;
PerlIO *fp;
- SV *sv;
GV * const gv
= (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
@@ -1540,7 +1539,6 @@ PP(pp_prtf)
}
}
- sv = newSV(0);
if (!io) {
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
@@ -1555,6 +1553,7 @@ PP(pp_prtf)
goto just_say_no;
}
else {
+ SV *sv = sv_newmortal();
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
@@ -1563,13 +1562,11 @@ PP(pp_prtf)
if (PerlIO_flush(fp) == EOF)
goto just_say_no;
}
- SvREFCNT_dec(sv);
SP = ORIGMARK;
PUSHs(&PL_sv_yes);
RETURN;
just_say_no:
- SvREFCNT_dec(sv);
SP = ORIGMARK;
PUSHs(&PL_sv_undef);
RETURN;
diff --git a/t/op/concat2.t b/t/op/concat2.t
index 2a66c3c..36b62bc 100644
--- a/t/op/concat2.t
+++ b/t/op/concat2.t
@@ -9,14 +9,25 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
- skip_all_if_miniperl("no dynamic loading on miniperl, no Encode");
}
-plan 1;
+plan 2;
+SKIP: {
+skip_if_miniperl("no dynamic loading on miniperl, no Encode", 1);
fresh_perl_is <<'end', "ok\n", {},
use encoding 'utf8';
map { "a" . $a } ((1)x5000);
print "ok\n";
end
"concat does not lose its stack pointer after utf8 upgrade [perl #78674]";
+}
+
+# This test is in the file because overload.pm uses concatenation.
+{ package o; use overload '""' => sub { $_[0][0] } }
+$x = bless[chr 256],o::;
+"$x";
+$x->[0] = "\xff";
+$x.= chr 257;
+$x.= chr 257;
+is $x, "\xff\x{101}\x{101}", '.= is not confused by changing utf8ness';
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 15ffb46..3e70598 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 43;
+plan tests => 45;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -301,3 +301,16 @@ leak(2, 0, sub {
}, "/(?{})\$x/ where \$x is $t does not leak");
}
}
+
+
+{
+ use warnings FATAL => 'all';
+ leak(2, 0, sub {
+ eval { printf uNopened 42 };
+ }, 'printfing to bad handle under fatal warnings does not leak');
+ open my $fh, ">", \my $buf;
+ leak(2, 0, sub {
+ eval { printf $fh chr 2455 };
+ }, 'wide fatal warning does not make printf leak');
+ close $fh or die $!;
+}
--
Perl5 Master Repository
