Change 29864 by [EMAIL PROTECTED] on 2007/01/17 23:29:13
Integrate:
[ 24912]
Same fix, for the test, now.
[ 26321]
Disallow sprintf's vector handling for non-integer formats.
Avoids core dump for printf("%vs") and similar.
[ 26326]
Drop "v" prefix from sprintf("%vd", $^V).
The sprintf documentation has this example:
printf "version is v%vd\n", $^V;
and it printed 'version is vv5.9.3\n'.
[ 26327]
Oops, change 26326 broke t/run/switches.t
Reverting change 24912 fixes it.
[ 26339]
Add overflow check to EXPECT_NUMBER() used by sv_vcatpvfn().
sprintf() or printf() will now croak if any of the indexes and
widths specified in the format string are too large.
[ 26342]
Remove tests that were not portable to 64bit ints.
Affected files ...
... //depot/maint-5.8/perl/pod/perldiag.pod#93 integrate
... //depot/maint-5.8/perl/sv.c#288 integrate
... //depot/maint-5.8/perl/t/op/sprintf.t#16 edit
... //depot/maint-5.8/perl/t/op/sprintf2.t#5 integrate
... //depot/maint-5.8/perl/t/run/switches.t#6 integrate
Differences ...
==== //depot/maint-5.8/perl/pod/perldiag.pod#93 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#92~29799~ 2007-01-13 15:25:00.000000000 -0800
+++ perl/pod/perldiag.pod 2007-01-17 15:29:13.000000000 -0800
@@ -1911,6 +1911,12 @@
internally--subject to loss of precision errors in subsequent
operations.
+=item Integer overflow in format string for %s
+
+(F) The indexes and widths specified in the format string of printf()
+or sprintf() are too large. The numbers must not overflow the size of
+integers for your architecture.
+
=item Internal disaster in regex; marked by <-- HERE in m/%s/
(P) Something went badly wrong in the regular expression parser.
==== //depot/maint-5.8/perl/sv.c#288 (text) ====
Index: perl/sv.c
--- perl/sv.c#287~29860~ 2007-01-17 14:08:43.000000000 -0800
+++ perl/sv.c 2007-01-17 15:29:13.000000000 -0800
@@ -7509,8 +7509,13 @@
case '1': case '2': case '3':
case '4': case '5': case '6':
case '7': case '8': case '9':
- while (isDIGIT(**pattern))
- var = var * 10 + (*(*pattern)++ - '0');
+ var = *(*pattern)++ - '0';
+ while (isDIGIT(**pattern)) {
+ I32 tmp = var * 10 + (*(*pattern)++ - '0');
+ if (tmp < var)
+ Perl_croak(aTHX_ "Integer overflow in format string for %s",
(PL_op ? OP_NAME(PL_op) : "sv_vcatpvfn"));
+ var = tmp;
+ }
}
return var;
}
@@ -7931,12 +7936,14 @@
if (*q == '%') {
eptr = q++;
elen = 1;
+ if (vectorize) {
+ c = '%';
+ goto unknown;
+ }
goto string;
}
- if (vectorize)
- argsv = vecsv;
- else if (!args) {
+ if (!vectorize && !args) {
if (efix) {
const I32 i = efix-1;
argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
@@ -7951,7 +7958,9 @@
/* STRINGS */
case 'c':
- uv = (args && !vectorize) ? va_arg(*args, int) : SvIVx(argsv);
+ if (vectorize)
+ goto unknown;
+ uv = (args) ? va_arg(*args, int) : SvIVx(argsv);
if ((uv > 255 ||
(!UNI_IS_INVARIANT(uv) && SvUTF8(sv)))
&& !IN_BYTES) {
@@ -7967,7 +7976,9 @@
goto string;
case 's':
- if (args && !vectorize) {
+ if (vectorize)
+ goto unknown;
+ if (args) {
eptr = va_arg(*args, char*);
if (eptr)
#ifdef MACOS_TRADITIONAL
@@ -8015,7 +8026,6 @@
is_utf8 = TRUE;
string:
- vectorize = FALSE;
if (has_precis && elen > precis)
elen = precis;
break;
@@ -8258,6 +8268,8 @@
case 'e': case 'E':
case 'f':
case 'g': case 'G':
+ if (vectorize)
+ goto unknown;
/* This is evil, but floating point is even more evil */
@@ -8290,7 +8302,7 @@
}
/* now we need (long double) if intsize == 'q', else (double) */
- nv = (args && !vectorize) ?
+ nv = (args) ?
#if LONG_DOUBLESIZE > DOUBLESIZE
intsize == 'q' ?
va_arg(*args, long double) :
@@ -8301,7 +8313,6 @@
: SvNVx(argsv);
need = 0;
- vectorize = FALSE;
if (c != 'e' && c != 'E') {
i = PERL_INT_MIN;
/* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
@@ -8464,8 +8475,10 @@
/* SPECIAL */
case 'n':
+ if (vectorize)
+ goto unknown;
i = SvCUR(sv) - origlen;
- if (args && !vectorize) {
+ if (args) {
switch (intsize) {
case 'h': *(va_arg(*args, short*)) = i; break;
default: *(va_arg(*args, int*)) = i; break;
@@ -8478,7 +8491,6 @@
}
else
sv_setuv_mg(argsv, (UV)i);
- vectorize = FALSE;
continue; /* not "break" */
/* UNKNOWN */
==== //depot/maint-5.8/perl/t/op/sprintf.t#16 (xtext) ====
Index: perl/t/op/sprintf.t
--- perl/t/op/sprintf.t#15~26697~ 2006-01-07 05:18:30.000000000 -0800
+++ perl/t/op/sprintf.t 2007-01-17 15:29:13.000000000 -0800
@@ -241,6 +241,7 @@
>%+vd< >chr(1)< >+1<
>%#vd< >chr(1)< >1<
>%vd< >"\01\02\03"< >1.2.3<
+>%vd< >v1.2.3< >1.2.3<
>%v.3d< >"\01\02\03"< >001.002.003<
>%0v3d< >"\01\02\03"< >001.002.003<
>%-v3d< >"\01\02\03"< >1 .2 .3 <
@@ -406,11 +407,18 @@
>%*2*2$d< >[12, 3]< >%*2*2$d INVALID<
>%*2$1d< >[12, 3]< >%*2$1d INVALID<
>%0v2.2d< >''< ><
->%vc,%d< >[63, 64, 65]< >?,64<
+>%vc,%d< >[63, 64, 65]< >%vc,63 INVALID<
+>%v%,%d< >[63, 64, 65]< >%v%,63 INVALID<
>%vd,%d< >[1, 2, 3]< >49,2<
->%vf,%d< >[1, 2, 3]< >1.000000,2<
+>%vf,%d< >[1, 2, 3]< >%vf,1 INVALID<
+>%vF,%d< >[1, 2, 3]< >%vF,1 INVALID<
+>%ve,%d< >[1, 2, 3]< >%ve,1 INVALID<
+>%vE,%d< >[1, 2, 3]< >%vE,1 INVALID<
+>%vg,%d< >[1, 2, 3]< >%vg,1 INVALID<
+>%vG,%d< >[1, 2, 3]< >%vG,1 INVALID<
>%vp< >''< >%vp INVALID<
->%vs,%d< >[1, 2, 3]< >1,2<
+>%vn< >''< >%vn INVALID<
+>%vs,%d< >[1, 2, 3]< >%vs,1 INVALID<
>%v_< >''< >%v_ INVALID<
>%v#x< >''< >%v#x INVALID<
>%v02x< >"foo\012"< >66.6f.6f.0a<
@@ -423,5 +431,5 @@
>%#b< >0< >0<
>%#o< >0< >0<
>%#x< >0< >0<
->%2918905856$v2d< >''< ><
->%*2918905856$v2d< >''< > UNINIT<
+>%2147483647$v2d< >''< ><
+>%*2147483647$v2d< >''< > UNINIT<
==== //depot/maint-5.8/perl/t/op/sprintf2.t#5 (text) ====
Index: perl/t/op/sprintf2.t
--- perl/t/op/sprintf2.t#4~26333~ 2005-12-12 07:40:56.000000000 -0800
+++ perl/t/op/sprintf2.t 2007-01-17 15:29:13.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 7 + 256;
+plan tests => 275;
is(
sprintf("%.40g ",0.01),
@@ -35,8 +35,15 @@
q(%n should not be able to modify read-only constants),
);
-# check %NNN$ for range bounds, especially negative 2's complement
+# check overflows
+for (int(~0/2+1), ~0, "9999999999999999999") {
+ is(eval {sprintf "%${_}d", 0}, undef, "no sprintf result expected %${_}d");
+ like($@, qr/^Integer overflow in format string for sprintf /, "overflow in
sprintf");
+ is(eval {printf "%${_}d\n", 0}, undef, "no printf result expected %${_}d");
+ like($@, qr/^Integer overflow in format string for prtf /, "overflow in
printf");
+}
+# check %NNN$ for range bounds
{
my ($warn, $bad) = (0,0);
local $SIG{__WARN__} = sub {
@@ -47,9 +54,10 @@
$bad++
}
};
- my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
- qw(a b c d);
- is($result, "abcd", "only four valid values");
+
+ my $fmt = join('', map("%$_\$s%" . ((1 << 31)-$_) . '$s', 1..20));
+ my $result = sprintf $fmt, qw(a b c d);
+ is($result, "abcd", "only four valid values in $fmt");
is($warn, 36, "expected warnings");
is($bad, 0, "unexpected warnings");
}
End of Patch.
