Change 30058 by [EMAIL PROTECTED] on 2007/01/29 16:46:38
Integrate:
[ 28917]
Subject: [perl #40427] Segfault in pack
From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]>
Date: Thu, 28 Sep 2006 17:30:37 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 28975]
fix bad free in do_exec3()
[ 28985]
Subject: [perl #40473] sprintf width+precision fails on wide chars
From: Anatoly Vorobey (via RT) <[EMAIL PROTECTED]>
Date: Sun, 08 Oct 2006 17:58:16 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 28993]
Missing % in format string
[ 29016]
Avoid undefined behaviour for -DPERL_MEM_LOG by not using a direct
dereference of member of the structure being reallocated as part of
the size calculation. (There may be other similar bugs).
[ 29025]
Subject: [PATCH] Re: sprintf 64 test
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Date: Sun, 15 Oct 2006 16:51:34 +0900
Message-Id: <[EMAIL PROTECTED]>
1. nullify 0 flag in integer conversions when precision is given
2. ignore space after a plus sign as a sign for a nonnegative number
3. make a negative precision through * working as if the precision
is omitted
Affected files ...
... //depot/maint-5.8/perl/doio.c#103 integrate
... //depot/maint-5.8/perl/perl.h#150 integrate
... //depot/maint-5.8/perl/pod/perlfunc.pod#89 integrate
... //depot/maint-5.8/perl/pp_pack.c#56 integrate
... //depot/maint-5.8/perl/regcomp.c#96 integrate
... //depot/maint-5.8/perl/sv.c#330 integrate
... //depot/maint-5.8/perl/t/op/sprintf.t#18 integrate
... //depot/maint-5.8/perl/t/op/sprintf2.t#7 integrate
Differences ...
==== //depot/maint-5.8/perl/doio.c#103 (text) ====
Index: perl/doio.c
--- perl/doio.c#102~30057~ 2007-01-29 07:55:07.000000000 -0800
+++ perl/doio.c 2007-01-29 08:46:38.000000000 -0800
@@ -1425,11 +1425,13 @@
{
register char **a;
register char *s;
+ char *buf;
char *cmd;
/* Make a copy so we can change it */
const Size_t cmdlen = strlen(incmd) + 1;
- Newx(cmd, cmdlen, char);
+ Newx(buf, cmdlen, char);
+ cmd = buf;
my_strlcpy(cmd, incmd, cmdlen);
while (*cmd && isSPACE(*cmd))
@@ -1464,7 +1466,7 @@
PERL_FPU_POST_EXEC
*s = '\'';
S_exec_failed(aTHX_ PL_cshname, fd, do_report);
- Safefree(cmd);
+ Safefree(buf);
return FALSE;
}
}
@@ -1512,7 +1514,7 @@
PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
- Safefree(cmd);
+ Safefree(buf);
return FALSE;
}
}
@@ -1542,7 +1544,7 @@
S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
}
do_execfree();
- Safefree(cmd);
+ Safefree(buf);
return FALSE;
}
==== //depot/maint-5.8/perl/perl.h#150 (text) ====
Index: perl/perl.h
--- perl/perl.h#149~30057~ 2007-01-29 07:55:07.000000000 -0800
+++ perl/perl.h 2007-01-29 08:46:38.000000000 -0800
@@ -3891,7 +3891,7 @@
EXTCONST char PL_no_helem[]
INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
EXTCONST char PL_no_helem_sv[]
- INIT("Modification of non-creatable hash value attempted, subscript
\""SVf"\"");
+ INIT("Modification of non-creatable hash value attempted, subscript
\"%"SVf"\"");
EXTCONST char PL_no_modify[]
INIT("Modification of a read-only value attempted");
EXTCONST char PL_no_mem[]
==== //depot/maint-5.8/perl/pod/perlfunc.pod#89 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod#88~29754~ 2007-01-11 05:30:43.000000000 -0800
+++ perl/pod/perlfunc.pod 2007-01-29 08:46:38.000000000 -0800
@@ -5431,6 +5431,12 @@
printf '<%06s>', 12; # prints "<000012>"
printf '<%#x>', 12; # prints "<0xc>"
+When a space and a plus sign are given as the flags at once,
+a plus sign is used to prefix a positive number.
+
+ printf '<%+ d>', 12; # prints "<+12>"
+ printf '<% +d>', 12; # prints "<+12>"
+
=item vector flag
This flag tells perl to interpret the supplied string as a vector of
@@ -5497,11 +5503,22 @@
printf '<%.4g>', 100.01; # prints "<100>"
For integer conversions, specifying a precision implies that the
-output of the number itself should be zero-padded to this width:
+output of the number itself should be zero-padded to this width,
+where the 0 flag is ignored:
+
+ printf '<%.6d>', 1; # prints "<000001>"
+ printf '<%+.6d>', 1; # prints "<+000001>"
+ printf '<%-10.6d>', 1; # prints "<000001 >"
+ printf '<%10.6d>', 1; # prints "< 000001>"
+ printf '<%010.6d>', 1; # prints "< 000001>"
+ printf '<%+10.6d>', 1; # prints "< +000001>"
printf '<%.6x>', 1; # prints "<000001>"
printf '<%#.6x>', 1; # prints "<0x000001>"
printf '<%-10.6x>', 1; # prints "<000001 >"
+ printf '<%10.6x>', 1; # prints "< 000001>"
+ printf '<%010.6x>', 1; # prints "< 000001>"
+ printf '<%#10.6x>', 1; # prints "< 0x000001>"
For string conversions, specifying a precision truncates the string
to fit in the specified width:
@@ -5514,6 +5531,18 @@
printf '<%.6x>', 1; # prints "<000001>"
printf '<%.*x>', 6, 1; # prints "<000001>"
+If a precision obtained through C<*> is negative, it has the same
+effect as no precision.
+
+ printf '<%.*s>', 7, "string"; # prints "<string>"
+ printf '<%.*s>', 3, "string"; # prints "<str>"
+ printf '<%.*s>', 0, "string"; # prints "<>"
+ printf '<%.*s>', -1, "string"; # prints "<string>"
+
+ printf '<%.*d>', 1, 0; # prints "<0>"
+ printf '<%.*d>', 0, 0; # prints "<>"
+ printf '<%.*d>', -1, 0; # prints "<0>"
+
You cannot currently get the precision from a specified number,
but it is intended that this will be possible in the future using
e.g. C<.*2$>:
==== //depot/maint-5.8/perl/pp_pack.c#56 (text) ====
Index: perl/pp_pack.c
--- perl/pp_pack.c#55~30051~ 2007-01-28 13:56:48.000000000 -0800
+++ perl/pp_pack.c 2007-01-29 08:46:38.000000000 -0800
@@ -2729,6 +2729,7 @@
if (savsym.howlen == e_star && beglist == endlist)
break; /* No way to continue */
}
+ items = endlist - beglist;
lookahead.flags = symptr->flags & ~group_modifiers;
goto no_change;
}
==== //depot/maint-5.8/perl/regcomp.c#96 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#95~30033~ 2007-01-27 08:40:35.000000000 -0800
+++ perl/regcomp.c 2007-01-29 08:46:38.000000000 -0800
@@ -1666,10 +1666,11 @@
S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
{
if (RExC_rx->data) {
+ const U32 count = RExC_rx->data->count;
Renewc(RExC_rx->data,
- sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count +
n - 1),
+ sizeof(*RExC_rx->data) + sizeof(void*) * (count + n - 1),
char, struct reg_data);
- Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
+ Renew(RExC_rx->data->what, count + n, U8);
RExC_rx->data->count += n;
}
else {
==== //depot/maint-5.8/perl/sv.c#330 (text) ====
Index: perl/sv.c
--- perl/sv.c#329~30057~ 2007-01-29 07:55:07.000000000 -0800
+++ perl/sv.c 2007-01-29 08:46:38.000000000 -0800
@@ -8040,7 +8040,10 @@
switch (*q) {
case ' ':
case '+':
- plus = *q++;
+ if (plus == '+' && *q == ' ') /* '+' over ' ' */
+ q++;
+ else
+ plus = *q++;
continue;
case '-':
@@ -8162,14 +8165,15 @@
else
i = (ewix ? ewix <= svmax : svix < svmax)
? SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0;
- precis = (i < 0) ? 0 : i;
+ precis = i;
+ has_precis = !(i < 0);
}
else {
precis = 0;
while (isDIGIT(*q))
precis = precis * 10 + (*q++ - '0');
+ has_precis = TRUE;
}
- has_precis = TRUE;
}
/* SIZE */
@@ -8285,13 +8289,17 @@
else {
eptr = SvPVx_const(argsv, elen);
if (DO_UTF8(argsv)) {
+ I32 old_precis = precis;
if (has_precis && precis < elen) {
I32 p = precis;
sv_pos_u2b(argsv, &p, 0); /* sticks at end */
precis = p;
}
if (width) { /* fudge width (can't fudge elen) */
- width += elen - sv_len_utf8(argsv);
+ if (has_precis && precis < elen)
+ width += precis - old_precis;
+ else
+ width += elen - sv_len_utf8(argsv);
}
is_utf8 = TRUE;
}
@@ -8543,6 +8551,10 @@
zeros = precis - elen;
else if (precis == 0 && elen == 1 && *ptr == '0')
elen = 0;
+
+ /* a precision nullifies the 0 flag. */
+ if (fill == '0')
+ fill = ' ';
}
}
break;
==== //depot/maint-5.8/perl/t/op/sprintf.t#18 (xtext) ====
Index: perl/t/op/sprintf.t
--- perl/t/op/sprintf.t#17~30003~ 2007-01-26 03:36:22.000000000 -0800
+++ perl/t/op/sprintf.t 2007-01-29 08:46:38.000000000 -0800
@@ -209,6 +209,13 @@
>%034b< >2**32-1< >0011111111111111111111111111111111<
>%-34b< >2**32-1< >11111111111111111111111111111111 <
>%-034b< >2**32-1< >11111111111111111111111111111111 <
+>%6b< >12< > 1100<
+>%6.5b< >12< > 01100<
+>%-6.5b< >12< >01100 <
+>%+6.5b< >12< > 01100<
+>% 6.5b< >12< > 01100<
+>%06.5b< >12< > 01100< >0 flag with precision: no effect<
+>%.5b< >12< >01100<
>%c< >ord('A')< >A<
>%10c< >ord('A')< > A<
>%#10c< >ord('A')< > A< ># modifier: no effect<
@@ -220,20 +227,53 @@
>%d< >123456.789< >123456<
>%d< >-123456.789< >-123456<
>%d< >0< >0<
+>%-d< >0< >0<
>%+d< >0< >+0<
+>% d< >0< > 0<
>%0d< >0< >0<
+>%-3d< >1< >1 <
+>%+3d< >1< > +1<
+>% 3d< >1< > 1<
+>%03d< >1< >001<
+>%+ 3d< >1< > +1<
+>% +3d< >1< > +1<
>%.0d< >0< ><
>%+.0d< >0< >+<
+>% .0d< >0< > <
+>%-.0d< >0< ><
+>%#.0d< >0< ><
>%.0d< >1< >1<
>%d< >1< >1<
>%+d< >1< >+1<
>%#3.2d< >1< > 01< ># modifier: no effect<
>%3.2d< >1< > 01<
->%03.2d< >1< >001<
+>%03.2d< >1< > 01< >0 flag with precision: no effect<
>%-3.2d< >1< >01 <
+>%+3.2d< >1< >+01<
+>% 3.2d< >1< > 01<
>%-03.2d< >1< >01 < >zero pad + left just.: no effect<
+>%3.*d< >[2,1]< > 01<
+>%3.*d< >[1,1]< > 1<
+>%3.*d< >[0,1]< > 1<
+>%3.*d< >[-1,1]< > 1<
+>%.*d< >[0,0]< ><
+>%-.*d< >[0,0]< ><
+>%+.*d< >[0,0]< >+<
+>% .*d< >[0,0]< > <
+>%0.*d< >[0,0]< ><
+>%.*d< >[-2,0]< >0<
+>%-.*d< >[-2,0]< >0<
+>%+.*d< >[-2,0]< >+0<
+>% .*d< >[-2,0]< > 0<
+>%0.*d< >[-2,0]< >0<
>%d< >-1< >-1<
+>%-d< >-1< >-1<
>%+d< >-1< >-1<
+>% d< >-1< >-1<
+>%-3d< >-1< >-1 <
+>%+3d< >-1< > -1<
+>% 3d< >-1< > -1<
+>%03d< >-1< >-01<
>%hd< >1< >1< >More extensive testing of<
>%ld< >1< >1< >length modifiers would be<
>%Vd< >1< >1< >platform-specific<
@@ -247,14 +287,14 @@
>%-v3d< >"\01\02\03"< >1 .2 .3 <
>%+-v3d< >"\01\02\03"< >+1 .2 .3 <
>%v4.3d< >"\01\02\03"< > 001. 002. 003<
->%0v4.3d< >"\01\02\03"< >0001.0002.0003<
+>%0v4.3d< >"\01\02\03"< > 001. 002. 003<
>%0*v2d< >['-', "\0\7\14"]< >00-07-12<
>%v.*d< >["\01\02\03", 3]< >001.002.003<
>%0v*d< >["\01\02\03", 3]< >001.002.003<
>%-v*d< >["\01\02\03", 3]< >1 .2 .3 <
>%+-v*d< >["\01\02\03", 3]< >+1 .2 .3 <
>%v*.*d< >["\01\02\03", 4, 3]< > 001. 002. 003<
->%0v*.*d< >["\01\02\03", 4, 3]< >0001.0002.0003<
+>%0v*.*d< >["\01\02\03", 4, 3]< > 001. 002. 003<
>%0*v*d< >['-', "\0\7\13", 2]< >00-07-11<
>%e< >1234.875< >1.234875e+03<
>%e< >0.000012345< >1.234500e-05<
@@ -355,7 +395,44 @@
>%#o< >2**32-1< >037777777777<
>%o< >642< >1202< >check smaller octals across
>platforms<
>%+o< >642< >1202<
+>% o< >642< >1202<
>%#o< >642< >01202<
+>%4o< >18< > 22<
+>%4.3o< >18< > 022<
+>%-4.3o< >18< >022 <
+>%+4.3o< >18< > 022<
+>% 4.3o< >18< > 022<
+>%04.3o< >18< > 022< >0 flag with precision: no effect<
+>%4.o< >36< > 44<
+>%-4.o< >36< >44 <
+>%+4.o< >36< > 44<
+>% 4.o< >36< > 44<
+>%04.o< >36< > 44< >0 flag with precision: no effect<
+>%.3o< >18< >022<
+>%#4o< >17< > 021<
+>%#-4o< >17< >021 <
+>%-#4o< >17< >021 <
+>%#+4o< >17< > 021<
+>%# 4o< >17< > 021<
+>%#04o< >17< >0021<
+>%#4.o< >16< > 020<
+>%#-4.o< >16< >020 <
+>%-#4.o< >16< >020 <
+>%#+4.o< >16< > 020<
+>%# 4.o< >16< > 020<
+>%#04.o< >16< > 020< >0 flag with precision: no effect<
+>%#4.3o< >18< > 022<
+>%#-4.3o< >18< >022 <
+>%-#4.3o< >18< >022 <
+>%#+4.3o< >18< > 022<
+>%# 4.3o< >18< > 022<
+>%#04.3o< >18< > 022< >0 flag with precision: no effect<
+>%#6.4o< >18< > 0022<
+>%#-6.4o< >18< >0022 <
+>%-#6.4o< >18< >0022 <
+>%#+6.4o< >18< > 0022<
+>%# 6.4o< >18< > 0022<
+>%#06.4o< >18< > 0022< >0 flag with precision: no effect<
>%d< >$p=sprintf('%p',$p);$p=~/^[0-9a-f]+$/< >1< >Coarse hack: hex from %p?<
>%d< >$p=sprintf('%-8p',$p);$p=~/^[0-9a-f]+\s*$/< >1< >Coarse hack: hex from
>%p?<
>%#p< >''< >%#p INVALID<
@@ -371,6 +448,15 @@
>%3s< >'string'< >string<
>%.3s< >'string'< >str<
>%.*s< >[3, 'string']< >str<
+>%.*s< >[2, 'string']< >st<
+>%.*s< >[1, 'string']< >s<
+>%.*s< >[0, 'string']< ><
+>%.*s< >[-1,'string']< >string< >negative precision to be ignored<
+>%3.*s< >[3, 'string']< >str<
+>%3.*s< >[2, 'string']< > st<
+>%3.*s< >[1, 'string']< > s<
+>%3.*s< >[0, 'string']< > <
+>%3.*s< >[-1,'string']< >string< >negative precision to be ignored<
>%t< >''< >%t INVALID<
>%u< >2**32-1< >4294967295<
>%+u< >2**32-1< >4294967295<
@@ -379,6 +465,13 @@
>%012u< >2**32-1< >004294967295<
>%-12u< >2**32-1< >4294967295 <
>%-012u< >2**32-1< >4294967295 <
+>%4u< >18< > 18<
+>%4.3u< >18< > 018<
+>%-4.3u< >18< >018 <
+>%+4.3u< >18< > 018<
+>% 4.3u< >18< > 018<
+>%04.3u< >18< > 018< >0 flag with precision: no effect<
+>%.3u< >18< >018<
>%v< >''< >%v INVALID<
>%w< >''< >%w INVALID<
>%x< >2**32-1< >ffffffff<
@@ -389,7 +482,60 @@
>%-10x< >2**32-1< >ffffffff <
>%-010x< >2**32-1< >ffffffff <
>%0-10x< >2**32-1< >ffffffff <
+>%4x< >18< > 12<
+>%4.3x< >18< > 012<
+>%-4.3x< >18< >012 <
+>%+4.3x< >18< > 012<
+>% 4.3x< >18< > 012<
+>%04.3x< >18< > 012< >0 flag with precision: no effect<
+>%.3x< >18< >012<
+>%4X< >28< > 1C<
+>%4.3X< >28< > 01C<
+>%-4.3X< >28< >01C <
+>%+4.3X< >28< > 01C<
+>% 4.3X< >28< > 01C<
+>%04.3X< >28< > 01C< >0 flag with precision: no effect<
+>%.3X< >28< >01C<
+>%.0x< >0< ><
+>%+.0x< >0< ><
+>% .0x< >0< ><
+>%-.0x< >0< ><
+>%#.0x< >0< ><
+>%#4x< >28< >0x1c<
+>%#4.3x< >28< >0x01c<
+>%#-4.3x< >28< >0x01c<
+>%#+4.3x< >28< >0x01c<
+>%# 4.3x< >28< >0x01c<
+>%#04.3x< >28< >0x01c< >0 flag with precision: no effect<
+>%#.3x< >28< >0x01c<
+>%#6.3x< >28< > 0x01c<
+>%#-6.3x< >28< >0x01c <
+>%-#6.3x< >28< >0x01c <
+>%#+6.3x< >28< > 0x01c<
+>%+#6.3x< >28< > 0x01c<
+>%# 6.3x< >28< > 0x01c<
+>% #6.3x< >28< > 0x01c<
>%0*x< >[-10, ,2**32-1]< >ffffffff <
+>%.*x< >[0,0]< ><
+>%-.*x< >[0,0]< ><
+>%+.*x< >[0,0]< ><
+>% .*x< >[0,0]< ><
+>%0.*x< >[0,0]< ><
+>%.*x< >[-3,0]< >0<
+>%-.*x< >[-3,0]< >0<
+>%+.*x< >[-3,0]< >0<
+>% .*x< >[-3,0]< >0<
+>%0.*x< >[-3,0]< >0<
+>%#.*x< >[0,0]< ><
+>%#-.*x< >[0,0]< ><
+>%#+.*x< >[0,0]< ><
+>%# .*x< >[0,0]< ><
+>%#0.*x< >[0,0]< ><
+>%#.*x< >[-1,0]< >0<
+>%#-.*x< >[-1,0]< >0<
+>%#+.*x< >[-1,0]< >0<
+>%# .*x< >[-1,0]< >0<
+>%#0.*x< >[-1,0]< >0<
>%y< >''< >%y INVALID<
>%z< >''< >%z INVALID<
>%2$d %1$d< >[12, 34]< >34 12<
==== //depot/maint-5.8/perl/t/op/sprintf2.t#7 (text) ====
Index: perl/t/op/sprintf2.t
--- perl/t/op/sprintf2.t#6~29995~ 2007-01-26 01:31:24.000000000 -0800
+++ perl/t/op/sprintf2.t 2007-01-29 08:46:38.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 280;
+plan tests => 1292;
is(
sprintf("%.40g ",0.01),
@@ -28,6 +28,15 @@
"width calculation under utf8 upgrade, length=$i");
}
+# check simultaneous width & precision with wide characters
+for my $i (1, 3, 5, 10) {
+ my $string = "\x{0410}"x($i+10); # cyrillic capital A
+ my $expect = "\x{0410}"x$i; # cut down to exactly $i characters
+ my $format = "%$i.${i}s";
+ is(sprintf($format, $string), $expect,
+ "width & precision interplay with utf8 strings, length=$i");
+}
+
# Used to mangle PL_sv_undef
fresh_perl_is(
'print sprintf "xxx%n\n"; print undef',
@@ -77,3 +86,52 @@
is ($bad, 0, "pattern '%v' . chr $ord");
}
}
+
+sub mysprintf_int_flags {
+ my ($fmt, $num) = @_;
+ die "wrong format $fmt" if $fmt !~ /^%([-+ 0]+)([1-9][0-9]*)d\z/;
+ my $flag = $1;
+ my $width = $2;
+ my $sign = $num < 0 ? '-' :
+ $flag =~ /\+/ ? '+' :
+ $flag =~ /\ / ? ' ' :
+ '';
+ my $abs = abs($num);
+ my $padlen = $width - length($sign.$abs);
+ return
+ $flag =~ /0/ && $flag !~ /-/ # do zero padding
+ ? $sign . '0' x $padlen . $abs
+ : $flag =~ /-/ # left or right
+ ? $sign . $abs . ' ' x $padlen
+ : ' ' x $padlen . $sign . $abs;
+}
+
+# Whole tests for "%4d" with 2 to 4 flags;
+# total counts: 3 * (4**2 + 4**3 + 4**4) == 1008
+
+my @flags = ("-", "+", " ", "0");
+for my $num (0, -1, 1) {
+ for my $f1 (@flags) {
+ for my $f2 (@flags) {
+ for my $f3 ('', @flags) { # '' for doubled flags
+ my $flag = $f1.$f2.$f3;
+ my $width = 4;
+ my $fmt = '%'."${flag}${width}d";
+ my $result = sprintf($fmt, $num);
+ my $expect = mysprintf_int_flags($fmt, $num);
+ is($result, $expect, qq/sprintf("$fmt",$num)/);
+
+ next if $f3 eq '';
+
+ for my $f4 (@flags) { # quadrupled flags
+ my $flag = $f1.$f2.$f3.$f4;
+ my $fmt = '%'."${flag}${width}d";
+ my $result = sprintf($fmt, $num);
+ my $expect = mysprintf_int_flags($fmt, $num);
+ is($result, $expect, qq/sprintf("$fmt",$num)/);
+ }
+ }
+ }
+ }
+}
+
End of Patch.
