change "#" to a comment starter in pack templates; "/" now

used for specifying counted types
	Message-ID: <19990922194130.A864@monk.mps.ohio-state.edu>
	Subject: [PATCH 5.005_61] Enable comments in pack()/unpack() templates

p4raw-id: //depot/perl@4222

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 607a410..551f059 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -65,26 +65,26 @@ no useful value.  See L<perlmod>.
 (F) The '!' is allowed in pack() and unpack() only after certain types.
 See L<perlfunc/pack>.
 
-=item # cannot take a count
+=item / cannot take a count
 
 (F) You had an unpack template indicating a counted-length string,
 but you have also specified an explicit size for the string.
 See L<perlfunc/pack>.
 
-=item # must be followed by a, A or Z
+=item / must be followed by a, A or Z
 
 (F) You had an unpack template indicating a counted-length string,
 which must be followed by one of the letters a, A or Z
 to indicate what sort of string is to be unpacked.
 See L<perlfunc/pack>.
 
-=item # must be followed by a*, A* or Z*
+=item / must be followed by a*, A* or Z*
 
 (F) You had an pack template indicating a counted-length string,
 Currently the only things that can have their length counted are a*, A* or Z*.
 See L<perlfunc/pack>.
 
-=item # must follow a numeric type
+=item / must follow a numeric type
 
 (F) You had an unpack template that contained a '#',
 but this did not follow some numeric unpack specification.

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 230dcd5..237a38d 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2809,9 +2809,9 @@ C<"P"> is C<undef>.
 
 =item *
 
-The C<"#"> character allows packing and unpacking of strings where the
+The C<"/"> character allows packing and unpacking of strings where the
 packed structure contains a byte count followed by the string itself.
-You write I<length-item>C<#>I<string-item>.
+You write I<length-item>C</>I<string-item>.
 
 The I<length-item> can be any C<pack> template letter,
 and describes how the length value is packed.
@@ -2823,9 +2823,9 @@ The I<string-item> must, at present, be C<"A*">, C<"a*"> or C<"Z*">.
 For C<unpack> the length of the string is obtained from the I<length-item>,
 but if you put in the '*' it will be ignored.
 
-    unpack 'C#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"
+    unpack 'C/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"
 
 The I<length-item> is not returned explicitly from C<unpack>.
 
@@ -2931,6 +2931,10 @@ could know where the bytes are going to or coming from.  Therefore
 C<pack> (and C<unpack>) handle their output and input as flat
 sequences of bytes.
 
+=item *
+
+A comment in a TEMPLATE starts with C<#> and goes to the end of line.
+
 =back
 
 Examples:

diff --git a/pp.c b/pp.c
index 6746aa5..773626f 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3288,6 +3288,11 @@ PP(pp_unpack)
 #endif
        if (isSPACE(datumtype))
            continue;
+       if (datumtype == '#') {
+           while (pat < patend && *pat != '\n')
+               pat++;
+           continue;
+       }
        if (*pat == '!') {
            char *natstr = "sSiIlL";
 
@@ -3347,16 +3352,16 @@ PP(pp_unpack)
                DIE(aTHX_ "x outside of string");
            s += len;
            break;
-       case '#':
+       case '/':
            if (oldsp >= SP)
-               DIE(aTHX_ "# must follow a numeric type");
+               DIE(aTHX_ "/ must follow a numeric type");
            if (*pat != 'a' && *pat != 'A' && *pat != 'Z')
-               DIE(aTHX_ "# must be followed by a, A or Z");
+               DIE(aTHX_ "/ must be followed by a, A or Z");
            datumtype = *pat++;
            if (*pat == '*')
                pat++;          /* ignore '*' for compatibility with pack */
            if (isDIGIT(*pat))
-               DIE(aTHX_ "# cannot take a count" );
+               DIE(aTHX_ "/ cannot take a count" );
            len = POPi;
            /* drop through */
        case 'A':
@@ -4345,6 +4350,11 @@ PP(pp_pack)
 #endif
        if (isSPACE(datumtype))
            continue;
+       if (datumtype == '#') {
+           while (pat < patend && *pat != '\n')
+               pat++;
+           continue;
+       }
         if (*pat == '!') {
            char *natstr = "sSiIlL";
 
@@ -4371,10 +4381,10 @@ PP(pp_pack)
        }
        else
            len = 1;
-       if (*pat == '#') {
+       if (*pat == '/') {
            ++pat;
            if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
-               DIE(aTHX_ "# must be followed by a*, A* or Z*");
+               DIE(aTHX_ "/ must be followed by a*, A* or Z*");
            lengthcode = sv_2mortal(newSViv(sv_len(items > 0
                                                   ? *MARK : &PL_sv_no)));
        }

diff --git a/t/op/pack.t b/t/op/pack.t
index 082b954..092e810 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -6,7 +6,7 @@ BEGIN {
     require Config; import Config;
 }
 
-print "1..148\n";
+print "1..152\n";
 
 $format = "c2 x5 C C x s d i l a6";
 # Need the expression in here to force ary[5] to be numeric.  This avoids
@@ -354,18 +354,34 @@ print "ok ", $test++, "\n";
 print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde";
 print "ok ", $test++, "\n";
 
-# 143..148: # 
+# 143..148: /
 
 my $z;
-eval { ($x) = unpack '#a*','hello' };
+eval { ($x) = unpack '/a*','hello' };
 print 'not ' unless $@; print "ok $test\n"; $test++;
-eval { ($z,$x,$y) = unpack 'a3#A C#a* C#Z', "003ok \003yes\004z\000abc" };
+eval { ($z,$x,$y) = unpack 'a3/A C/a* C/Z', "003ok \003yes\004z\000abc" };
 print $@ eq '' && $z eq 'ok' ? "ok $test\n" : "not ok $test\n"; $test++;
 print $@ eq '' && $x eq 'yes' ? "ok $test\n" : "not ok $test\n"; $test++;
 print $@ eq '' && $y eq 'z' ? "ok $test\n" : "not ok $test\n"; $test++;
 
-eval { ($x) = pack '#a*','hello' };
+eval { ($x) = pack '/a*','hello' };
 print 'not ' unless $@; print "ok $test\n"; $test++;
-$z = pack 'n#a* w#A*','string','etc';
+$z = pack 'n/a* w/A*','string','etc';
 print 'not ' unless $z eq "\000\006string\003etc"; print "ok $test\n"; $test++;
 
+# 149..152: / with #
+
+eval { ($z,$x,$y) = unpack <<EOU, "003ok \003yes\004z\000abc" };
+ a3/A                  # Count in ASCII
+ C/a*                  # Count in a C char
+ C/Z                   # Count in a C char but skip after \0
+EOU
+print $@ eq '' && $z eq 'ok' ? "ok $test\n" : "not ok $test\n"; $test++;
+print $@ eq '' && $x eq 'yes' ? "ok $test\n" : "not ok $test\n"; $test++;
+print $@ eq '' && $y eq 'z' ? "ok $test\n" : "not ok $test\n"; $test++;
+
+$z = pack <<EOP,'string','etc';
+  n/a*                 # Count as network short
+  w/A*                 # Count a  BER integer
+EOP
+print 'not ' unless $z eq "\000\006string\003etc"; print "ok $test\n"; $test++;