Change 29995 by [EMAIL PROTECTED] on 2007/01/26 09:31:24
Integrate:
[ 28328]
Subject: Re: [perl #39126] possible memory related bug when using
sprintf with an utf-8 encoded format-string and iso-8859-1 encoded string
variables.
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Date: Sun, 21 May 2006 19:33:21 +0900
Message-Id: <[EMAIL PROTECTED]>
with test tweaks further suggested by the same
[ 28331]
make require report too many open files error
ie don't continue searching the rest of @INC
[ 28364]
Subject: [PATCH] exhausting <> in BEGIN{} gets ARGVOUT used only once
warning
From: Yitzchak Scott-Thoennes <[EMAIL PROTECTED]>
Date: Tue, 6 Jun 2006 22:24:46 -0700
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/gv.c#93 integrate
... //depot/maint-5.8/perl/pp_ctl.c#161 integrate
... //depot/maint-5.8/perl/sv.c#321 integrate
... //depot/maint-5.8/perl/t/op/readline.t#4 integrate
... //depot/maint-5.8/perl/t/op/sprintf2.t#6 integrate
Differences ...
==== //depot/maint-5.8/perl/gv.c#93 (text) ====
Index: perl/gv.c
--- perl/gv.c#92~29980~ 2007-01-25 13:15:39.000000000 -0800
+++ perl/gv.c 2007-01-26 01:31:24.000000000 -0800
@@ -995,6 +995,9 @@
if (strEQ(name2, "RGV")) {
IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
}
+ else if (strEQ(name2, "RGVOUT")) {
+ GvMULTI_on(gv);
+ }
break;
case 'E':
if (strnEQ(name2, "XPORT", 5))
==== //depot/maint-5.8/perl/pp_ctl.c#161 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#160~29986~ 2007-01-25 15:07:41.000000000 -0800
+++ perl/pp_ctl.c 2007-01-26 01:31:24.000000000 -0800
@@ -3277,6 +3277,9 @@
tryname += 2;
break;
}
+ else if (errno == EMFILE)
+ /* no point in trying other paths if out of handles */
+ break;
}
}
}
==== //depot/maint-5.8/perl/sv.c#321 (text) ====
Index: perl/sv.c
--- perl/sv.c#320~29988~ 2007-01-25 15:24:46.000000000 -0800
+++ perl/sv.c 2007-01-26 01:31:24.000000000 -0800
@@ -8756,7 +8756,25 @@
continue; /* not "break" */
}
- /* calculate width before utf8_upgrade changes it */
+ if (is_utf8 != has_utf8) {
+ if (is_utf8) {
+ if (SvCUR(sv))
+ sv_utf8_upgrade(sv);
+ }
+ else {
+ const STRLEN old_elen = elen;
+ SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
+ sv_utf8_upgrade(nsv);
+ eptr = SvPVX_const(nsv);
+ elen = SvCUR(nsv);
+
+ if (width) { /* fudge width (can't fudge elen) */
+ width += elen - old_elen;
+ }
+ is_utf8 = TRUE;
+ }
+ }
+
have = esignlen + zeros + elen;
if (have < zeros)
Perl_croak_nocontext(PL_memory_wrap);
==== //depot/maint-5.8/perl/t/op/readline.t#4 (text) ====
Index: perl/t/op/readline.t
--- perl/t/op/readline.t#3~21820~ 2003-11-30 02:11:14.000000000 -0800
+++ perl/t/op/readline.t 2007-01-26 01:31:24.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 13;
+plan tests => 14;
eval { for (\2) { $_ = <FH> } };
like($@, 'Modification of a read-only value attempted', '[perl #19566]');
@@ -83,6 +83,10 @@
}
}
+fresh_perl_is('BEGIN{<>}', '',
+ { switches => ['-w'], stdin => '', stderr => 1 },
+ 'No ARGVOUT used only once warning');
+
__DATA__
moo
moo
==== //depot/maint-5.8/perl/t/op/sprintf2.t#6 (text) ====
Index: perl/t/op/sprintf2.t
--- perl/t/op/sprintf2.t#5~29864~ 2007-01-17 15:29:13.000000000 -0800
+++ perl/t/op/sprintf2.t 2007-01-26 01:31:24.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 275;
+plan tests => 280;
is(
sprintf("%.40g ",0.01),
@@ -18,13 +18,14 @@
sprintf("%.40f", 0.01)." ",
q(the sprintf "%.<number>f" optimization)
);
-{
- chop(my $utf8_format = "%-3s\x{100}");
- is(
- sprintf($utf8_format, "\xe4"),
- "\xe4 ",
- q(width calculation under utf8 upgrade)
- );
+
+# cases of $i > 1 are against [perl #39126]
+for my $i (1, 5, 10, 20, 50, 100) {
+ chop(my $utf8_format = "%-*s\x{100}");
+ my $string = "\xB4"x$i; # latin1 ACUTE or ebcdic COPYRIGHT
+ my $expect = $string." "x$i; # followed by 2*$i spaces
+ is(sprintf($utf8_format, 3*$i, $string), $expect,
+ "width calculation under utf8 upgrade, length=$i");
}
# Used to mangle PL_sv_undef
End of Patch.
