Make the ! suffix handle n/N/v/V as signed integers

within pack templates.

p4raw-id: //depot/perl@22663

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 3db7ca7..b3927a2 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -3305,7 +3305,11 @@ of values, as follows:
     v  An unsigned short in "VAX" (little-endian) order.
     V  An unsigned long in "VAX" (little-endian) order.
          (These 'shorts' and 'longs' are _exactly_ 16 bits and
-          _exactly_ 32 bits, respectively.)
+          _exactly_ 32 bits, respectively. If you want signed
+          types instead of unsigned ones, use the '!' suffix.
+          Note that this is _only_ safe if signed integers are
+          stored in the same format on all platforms using the
+          packed data.)
 
     q  A signed quad (64-bit) value.
     Q  An unsigned quad value.
@@ -3608,6 +3612,14 @@ both result in no-ops.
 
 =item *
 
+C<n>, C<N>, C<v> and C<V> accept the C<!> modifier. In this case they
+will represent signed 16-/32-bit integers in big-/little-endian order.
+This is only portable if all platforms sharing the packed data use the
+same binary representation for signed integers (e.g. all platforms are
+using two's complement representation).
+
+=item *
+
 A comment in a TEMPLATE starts with C<#> and goes to the end of line.
 White space may be used to separate pack codes from each other, but
 a C<!> modifier and a repeat count must follow immediately.

diff --git a/pp_pack.c b/pp_pack.c
index aca8f82..e51a2b9 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -244,6 +244,8 @@ S_measure_struct(pTHX_ register tempsym_t* symptr)
 #else
             /* FALL THROUGH */
 #endif
+       case 'v' | TYPE_IS_SHRIEKING:
+       case 'n' | TYPE_IS_SHRIEKING:
        case 'v':
        case 'n':
        case 'S':
@@ -280,6 +282,8 @@ S_measure_struct(pTHX_ register tempsym_t* symptr)
 #else
             /* FALL THROUGH */
 #endif
+       case 'V' | TYPE_IS_SHRIEKING:
+       case 'N' | TYPE_IS_SHRIEKING:
        case 'V':
        case 'N':
        case 'L':
@@ -413,7 +417,7 @@ S_next_symbol(pTHX_ register tempsym_t* symptr )
 
       /* test for '!' modifier */
       if (patptr < patend && *patptr == '!') {
-       static const char natstr[] = "sSiIlLxX";
+       static const char natstr[] = "sSiIlLxXnNvV";
         patptr++;              
         if (strchr(natstr, code))
          code |= TYPE_IS_SHRIEKING;
@@ -551,8 +555,10 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
     Quad_t aquad;
 #endif
     U16 aushort;
+    I16 asshort;
     unsigned int auint;
     U32 aulong;
+    I32 aslong;
 #ifdef HAS_QUAD
     Uquad_t auquad;
 #endif
@@ -1007,7 +1013,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                    if (checksum > bits_in_uv)
                        cdouble += (NV)aushort;
                    else
-                       cuv += aushort;
+                       cuv += aushort;
                }
            }
            else {
@@ -1032,6 +1038,51 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                }
            }
            break;
+       case 'v' | TYPE_IS_SHRIEKING:
+       case 'n' | TYPE_IS_SHRIEKING:
+           along = (strend - s) / SIZE16;
+           if (len > along)
+               len = along;
+           if (checksum) {
+               while (len-- > 0) {
+                   COPY16(s, &asshort);
+                   s += SIZE16;
+#ifdef HAS_NTOHS
+                   if (datumtype == ('n' | TYPE_IS_SHRIEKING))
+                       asshort = (I16)PerlSock_ntohs((U16)asshort);
+#endif
+#ifdef HAS_VTOHS
+                   if (datumtype == ('v' | TYPE_IS_SHRIEKING))
+                       asshort = (I16)vtohs((U16)asshort);
+#endif
+                   if (checksum > bits_in_uv)
+                       cdouble += (NV)asshort;
+                   else
+                       cuv += asshort;
+               }
+           }
+           else {
+                if (len && unpack_only_one)
+                    len = 1;
+               EXTEND(SP, len);
+               EXTEND_MORTAL(len);
+               while (len-- > 0) {
+                   COPY16(s, &asshort);
+                   s += SIZE16;
+#ifdef HAS_NTOHS
+                   if (datumtype == ('n' | TYPE_IS_SHRIEKING))
+                       asshort = (I16)PerlSock_ntohs((U16)asshort);
+#endif
+#ifdef HAS_VTOHS
+                   if (datumtype == ('v' | TYPE_IS_SHRIEKING))
+                       asshort = (I16)vtohs((U16)asshort);
+#endif
+                   sv = NEWSV(39, 0);
+                   sv_setiv(sv, (IV)asshort);
+                   PUSHs(sv_2mortal(sv));
+               }
+           }
+           break;
        case 'i':
        case 'i' | TYPE_IS_SHRIEKING:
            along = (strend - s) / sizeof(int);
@@ -1332,6 +1383,51 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
                }
            }
            break;
+       case 'V' | TYPE_IS_SHRIEKING:
+       case 'N' | TYPE_IS_SHRIEKING:
+           along = (strend - s) / SIZE32;
+           if (len > along)
+               len = along;
+           if (checksum) {
+               while (len-- > 0) {
+                   COPY32(s, &aslong);
+                   s += SIZE32;
+#ifdef HAS_NTOHL
+                   if (datumtype == ('N' | TYPE_IS_SHRIEKING))
+                       aslong = (I32)PerlSock_ntohl((U32)aslong);
+#endif
+#ifdef HAS_VTOHL
+                   if (datumtype == ('V' | TYPE_IS_SHRIEKING))
+                       aslong = (I32)vtohl((U32)aslong);
+#endif
+                   if (checksum > bits_in_uv)
+                       cdouble += (NV)aslong;
+                   else
+                       cuv += aslong;
+               }
+           }
+           else {
+                if (len && unpack_only_one)
+                    len = 1;
+               EXTEND(SP, len);
+               EXTEND_MORTAL(len);
+               while (len-- > 0) {
+                   COPY32(s, &aslong);
+                   s += SIZE32;
+#ifdef HAS_NTOHL
+                   if (datumtype == ('N' | TYPE_IS_SHRIEKING))
+                       aslong = (I32)PerlSock_ntohl((U32)aslong);
+#endif
+#ifdef HAS_VTOHL
+                   if (datumtype == ('V' | TYPE_IS_SHRIEKING))
+                       aslong = (I32)vtohl((U32)aslong);
+#endif
+                   sv = NEWSV(43, 0);
+                   sv_setiv(sv, (IV)aslong);
+                   PUSHs(sv_2mortal(sv));
+               }
+           }
+           break;
        case 'p':
            along = (strend - s) / sizeof(char*);
            if (len > along)
@@ -2285,6 +2381,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
            }
            break;
 #endif
+       case 'n' | TYPE_IS_SHRIEKING:
        case 'n':
            while (len-- > 0) {
                fromstr = NEXTFROM;
@@ -2295,6 +2392,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                CAT16(cat, &ashort);
            }
            break;
+       case 'v' | TYPE_IS_SHRIEKING:
        case 'v':
            while (len-- > 0) {
                fromstr = NEXTFROM;
@@ -2485,6 +2583,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                sv_catpvn(cat, (char*)&aint, sizeof(int));
            }
            break;
+       case 'N' | TYPE_IS_SHRIEKING:
        case 'N':
            while (len-- > 0) {
                fromstr = NEXTFROM;
@@ -2495,6 +2594,7 @@ S_pack_rec(pTHX_ SV *cat, register tempsym_t* symptr, register SV **beglist, SV
                CAT32(cat, &aulong);
            }
            break;
+       case 'V' | TYPE_IS_SHRIEKING:
        case 'V':
            while (len-- > 0) {
                fromstr = NEXTFROM;

diff --git a/t/op/pack.t b/t/op/pack.t
index 6e3d6e4..a4c8e91 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 5852;
+plan tests => 6076;
 
 use strict;
 use warnings;
@@ -510,6 +510,10 @@ numbers ('n', 0, 1, 32767, 32768, 65535);
 numbers ('v', 0, 1, 32767, 32768, 65535);
 numbers ('N', 0, 1, 2147483647, 2147483648, 4294967295);
 numbers ('V', 0, 1, 2147483647, 2147483648, 4294967295);
+numbers ('n!', -32768, -1, 0, 1, 32767);
+numbers ('v!', -32768, -1, 0, 1, 32767);
+numbers ('N!', -2147483648, -1, 0, 1, 2147483647);
+numbers ('V!', -2147483648, -1, 0, 1, 2147483647);
 # All these should have exact binary representations:
 numbers ('f', -1, 0, 0.5, 42, 2**34);
 numbers ('d', -(2**34), -1, 0, 1, 2**34);
@@ -539,6 +543,11 @@ is(pack("v", 0xdead), "\xad\xde");
 is(pack("N", 0xdeadbeef), "\xde\xad\xbe\xef");
 is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
 
+is(pack("n!", 0xdead), "\xde\xad");
+is(pack("v!", 0xdead), "\xad\xde");
+is(pack("N!", 0xdeadbeef), "\xde\xad\xbe\xef");
+is(pack("V!", 0xdeadbeef), "\xef\xbe\xad\xde");
+
 {
   # /