From: Ton Hospel Date: Sat, 19 Mar 2005 22:00:45 +0000 (+0000) Subject: pack / for general types X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=246f24af48839a0c276d6836d932a864d54afe73;p=p5sagit%2Fp5-mst-13.2.git pack / for general types Message-Id: Allow "len/format" to work for any format type, not just strings. p4raw-id: //depot/perl@24052 --- diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3687d41..0f71025 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2336,12 +2336,6 @@ See L for details. (W syntax) Multidimensional arrays aren't written like C<$foo[1,2,3]>. They're written like C<$foo[1][2][3]>, as in C. -=item '/' must be followed by 'a*', 'A*' or 'Z*' - -(F) You had a pack template indicating a counted-length string, -Currently the only things that can have their length counted are a*, A* -or Z*. See L. - =item '/' must follow a numeric type in unpack (F) You had an unpack template that contained a '/', but this did not diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 559e94b..9785a25 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3502,24 +3502,32 @@ so will result in a fatal error. =item * -The C template character allows packing and unpacking of strings where -the packed structure contains a byte count followed by the string itself. -You write ICI. +The C template character allows packing and unpacking of a sequence of +items where the packed structure contains a packed item count followed by +the packed items themselves. +You write ICI. The I can be any C template letter, and describes how the length value is packed. The ones likely to be of most use are integer-packing ones like C (for Java strings), C (for ASN.1 or SNMP) and C (for Sun XDR). -For C, the I must, at present, be C<"A*">, C<"a*"> or -C<"Z*">. For C the length of the string is obtained from the -I, but if you put in the '*' it will be ignored. For all other -codes, C applies the length value to the next item, which must not -have a repeat count. - - unpack 'W/a', "\04Gurusamy"; gives 'Guru' - unpack 'a3/A* A*', '007 Bond J '; gives (' Bond','J') - pack 'n/a* w/a*','hello,','world'; gives "\000\006hello,\005world" +For C, the I may have a repeat count, in which case +the minimum of that and the number of available items is used as argument +for the I. If it has no repeat count or uses a '*', the number +of available items is used. For C the repeat count is always obtained +by decoding the packed item count, and the I must not have a +repeat count. + +If the I refers to a string type (C<"A">, C<"a"> or C<"Z">), +the I is a string length, not a number of strings. If there is +an explicit repeat count for pack, the packed string will be adjusted to that +given length. + + unpack 'W/a', "\04Gurusamy"; gives ('Guru') + unpack 'a3/A* A*', '007 Bond J '; gives (' Bond', 'J') + pack 'n/a* w/a','hello,','world'; gives "\000\006hello,\005world" + pack 'a/W2', ord('a') .. ord('z'); gives '2ab' The I is not returned explicitly from C. diff --git a/pp_pack.c b/pp_pack.c index e62f56d..1b56392 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -2471,13 +2471,26 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) /* Look ahead for next symbol. Do we have code/code? */ lookahead = *symptr; found = next_symbol(&lookahead); - if ( symptr->flags & FLAG_SLASH ) { + if (symptr->flags & FLAG_SLASH) { + IV count; if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack"); - if ( 0 == strchr( "aAZ", lookahead.code ) || - e_star != lookahead.howlen ) - Perl_croak(aTHX_ "'/' must be followed by 'a*', 'A*' or 'Z*' in pack"); - lengthcode = - sv_2mortal(newSViv((items > 0 ? DO_UTF8(*beglist) ? sv_len_utf8(*beglist) : sv_len(*beglist) : 0) + (lookahead.code == 'Z' ? 1 : 0))); + if (strchr("aAZ", lookahead.code)) { + if (lookahead.howlen == e_number) count = lookahead.length; + else { + if (items > 0) + count = DO_UTF8(*beglist) ? + sv_len_utf8(*beglist) : sv_len(*beglist); + else count = 0; + if (lookahead.code == 'Z') count++; + } + } else { + if (lookahead.howlen == e_number && lookahead.length < items) + count = lookahead.length; + else count = items; + } + lookahead.howlen = e_number; + lookahead.length = count; + lengthcode = sv_2mortal(newSViv(count)); } /* Code inside the switch must take care to properly update diff --git a/t/op/pack.t b/t/op/pack.t index 06c3a9a..3009510 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' : my $no_signedness = $] > 5.009 ? '' : "Signed/unsigned pack modifiers not available on this perl"; -plan tests => 14606; +plan tests => 14621; use strict; use warnings; @@ -1782,3 +1782,28 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_ is(pack("U0A*", $high), "\xfeb"); is(pack("U0Z*", $high), "\xfeb\x00"); } +{ + # pack / + my @array = 1..14; + my @out = unpack("N/S", pack("N/S", @array) . "abcd"); + is("@out", "@array", "pack N/S works"); + @out = unpack("N/S*", pack("N/S*", @array) . "abcd"); + is("@out", "@array", "pack N/S* works"); + @out = unpack("N/S*", pack("N/S14", @array) . "abcd"); + is("@out", "@array", "pack N/S14 works"); + @out = unpack("N/S*", pack("N/S15", @array) . "abcd"); + is("@out", "@array", "pack N/S15 works"); + @out = unpack("N/S*", pack("N/S13", @array) . "abcd"); + is("@out", "@array[0..12]", "pack N/S13 works"); + @out = unpack("N/S*", pack("N/S0", @array) . "abcd"); + is("@out", "", "pack N/S0 works"); + is(pack("Z*/a0", "abc"), "0\0", "pack Z*/a0 makes a short string"); + is(pack("Z*/Z0", "abc"), "0\0", "pack Z*/Z0 makes a short string"); + is(pack("Z*/a3", "abc"), "3\0abc", "pack Z*/a3 makes a full string"); + is(pack("Z*/Z3", "abc"), "3\0ab\0", "pack Z*/Z3 makes a short string"); + is(pack("Z*/a5", "abc"), "5\0abc\0\0", "pack Z*/a5 makes a long string"); + is(pack("Z*/Z5", "abc"), "5\0abc\0\0", "pack Z*/Z5 makes a long string"); + is(pack("Z*/Z"), "1\0\0", "pack Z*/Z makes an extended string"); + is(pack("Z*/Z", ""), "1\0\0", "pack Z*/Z makes an extended string"); + is(pack("Z*/a", ""), "0\0", "pack Z*/a makes an extended string"); +}