A missing test to blead for "u" too wide:
--- perl-dev/t/op/pack.t Sat Jan 22 01:21:58 2005
+++ perl-dev2/t/op/pack.t Sat Mar 12 19:19:55 2005
@@ -5,7 +5,7 @@
require './test.pl';
}
-plan tests => 13679;
+plan tests => 13681;
use strict;
use warnings;
@@ -1404,4 +1404,16 @@
is(scalar @a, 200, "[perl #15288]");
is($a[-1], "01234567\n", "[perl #15288]");
is($a[-2], "X", "[perl #15288]");
+}
+
+{
+ my $warning;
+ local $SIG{__WARN__} = sub {
+ $warning = $_[0];
+ };
+ my $out = pack("u99", "foo" x 99);
+ like($warning, qr/Field too wide in 'u' format in pack at /,
+ "Warn about too wide uuencode");
+ is($out, ("_" . "9F]O" x 21 . "\n") x 4 . "M" . "9F]O" x 15 . "\n",
+ "Use max width in case of too wide uuencode");
}
And the corresponding patch for perl 5.8 (fixes bug 32766)
diff -ur perl-5.8.6/pod/perldiag.pod perl-stable/pod/perldiag.pod
--- perl-5.8.6/pod/perldiag.pod Wed Nov 17 15:59:09 2004
+++ perl-stable/pod/perldiag.pod Sat Mar 12 18:27:30 2005
@@ -1526,6 +1526,13 @@
(F) Your machine apparently doesn't implement fcntl(). What is this, a
PDP-11 or something?
+=item Field too wide in 'u' format in pack
+
+(W pack) Each line in an uuencoded string start with a length indicator
+which can't encode values above 63. So there is no point in asking for
+a line length bigger than that. Perl will behave as if you specified
+C<u63> as format.
+
=item Filehandle %s opened only for input
(W io) You tried to write on a read-only filehandle. If you intended
diff -ur perl-5.8.6/pod/perlfunc.pod perl-stable/pod/perlfunc.pod
--- perl-5.8.6/pod/perlfunc.pod Sat Nov 27 16:12:40 2004
+++ perl-stable/pod/perlfunc.pod Sat Mar 12 18:22:40 2005
@@ -3384,8 +3384,9 @@
of the item).
The repeat count for C<u> is interpreted as the maximal number of bytes
-to encode per line of output, with 0 and 1 replaced by 45.
+to encode per line of output, with 0, 1 and 2 replaced by 45. The repeat
+count should not be more than 65.
=item *
--- perl-5.8.6/pp_pack.c Fri Sep 10 09:06:58 2004
+++ perl-stable/pp_pack.c Sat Mar 12 18:19:05 2005
@@ -2598,14 +2598,18 @@
}
break;
case 'u':
- fromstr = NEXTFROM;
- aptr = SvPV(fromstr, fromlen);
- SvGROW(cat, fromlen * 4 / 3);
if (len <= 2)
len = 45;
- else
+ else if (len >= 66) {
+ Perl_warner(aTHX_ packWARN(WARN_PACK),
+ "Field too wide in 'u' format in pack");
+ len = 63;
+ } else
len = len / 3 * 3;
+ fromstr = NEXTFROM;
+ aptr = SvPV(fromstr, fromlen);
+ SvGROW(cat, SvCUR(cat) + (fromlen+2) / 3 * 4 + (fromlen+len-1)/len
* 2);
while (fromlen > 0) {
I32 todo;
--- perl-5.8.6/t/op/pack.t Sat Oct 18 21:46:30 2003
+++ perl-stable/t/op/pack.t Sat Mar 12 18:51:04 2005
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 5852;
+plan tests => 5854;
use strict;
use warnings;
@@ -1127,4 +1127,16 @@
is(scalar @a, 200, "[perl #15288]");
is($a[-1], "01234567\n", "[perl #15288]");
is($a[-2], "X", "[perl #15288]");
+}
+
+{
+ my $warning;
+ local $SIG{__WARN__} = sub {
+ $warning = $_[0];
+ };
+ my $out = pack("u99", "foo" x 99);
+ like($warning, qr/Field too wide in 'u' format in pack at /,
+ "Warn about too wide uuencode");
+ is($out, ("_" . "9F]O" x 21 . "\n") x 4 . "M" . "9F]O" x 15 . "\n",
+ "Use max width in case of too wide uuencode");
}
