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

within pack templates.

p4raw-id: //depot/perl@22663

3 files changed, 125 insertions, 4 deletions

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 3db7ca77ba..b3927a262b 100644
--- 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 aca8f8274b..e51a2b9c61 100644
--- 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 6e3d6e4ff2..a4c8e91652 100755
--- 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");
+
 {
   # /