From: Jarkko Hietaniemi Date: Fri, 19 Feb 1999 20:43:19 +0000 (+0000) Subject: pack/unpack better in (network-)short-non-16-bits and X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c67712b2e649d3ea6de971bd2e9efe6087948fc1;p=p5sagit%2Fp5-mst-13.2.git pack/unpack better in (network-)short-non-16-bits and (network-)long-non-32-bits systems such as Cray C90. p4raw-id: //depot/cfgperl@2985 --- diff --git a/perl.h b/perl.h index 42505f0..0accd02 100644 --- a/perl.h +++ b/perl.h @@ -1613,7 +1613,7 @@ typedef I32 CHECKPOINT; # define HAS_VTOHS # define HAS_HTOVL # define HAS_HTOVS -# if BYTEORDER == 0x4321 +# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 # define vtohl(x) ((((x)&0xFF)<<24) \ +(((x)>>24)&0xFF) \ +(((x)&0x0000FF00)<<8) \ diff --git a/pp.c b/pp.c index d5b7081..a9ced11 100644 --- a/pp.c +++ b/pp.c @@ -3549,6 +3549,10 @@ PP(pp_unpack) { while (len-- > 0) { COPY16(s, &ashort); +#if SHORTSIZE > SIZE16 + if (ashort > 32767) + ashort -= 65536; +#endif s += SIZE16; culong += ashort; } @@ -3572,6 +3576,10 @@ PP(pp_unpack) { while (len-- > 0) { COPY16(s, &ashort); +#if SHORTSIZE > SIZE16 + if (ashort > 32767) + ashort -= 65536; +#endif s += SIZE16; sv = NEWSV(38, 0); sv_setiv(sv, (IV)ashort); @@ -3747,6 +3755,10 @@ PP(pp_unpack) { while (len-- > 0) { COPY32(s, &along); +#if LONGSIZE > SIZE32 + if (along > 2147483647) + along -= 4294967296; +#endif s += SIZE32; if (checksum > 32) cdouble += (double)along; @@ -3773,6 +3785,10 @@ PP(pp_unpack) { while (len-- > 0) { COPY32(s, &along); +#if LONGSIZE > SIZE32 + if (along > 2147483647) + along -= 4294967296; +#endif s += SIZE32; sv = NEWSV(42, 0); sv_setiv(sv, (IV)along); @@ -4555,7 +4571,7 @@ PP(pp_pack) } break; case 's': -#if SHORTSIZE != 2 +#if SHORTSIZE != SIZE16 if (natint) { while (len-- > 0) { fromstr = NEXTFROM; diff --git a/t/op/pack.t b/t/op/pack.t index 3e31e36..f1bb62f 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -298,17 +298,8 @@ print "ok ", $test++, "\n"; print "not " unless unpack("s", pack("s", 32767)) == 32767; print "ok ", $test++, "\n"; -if ($Config{shortsize} == 2) { - print "not " unless unpack("s", pack("s", -32768)) == -32768; - print "ok ", $test++, "\n"; -} else { - if ($Config{shortsize} == 8 && $Config{byteorder} eq '87654321') { - print "not " unless unpack("s_", pack("s_", -32768)) == -32768; - print "ok ", $test++, "\n"; - } else { - print "ok ", $test++, " # skipped\n"; - } -} +print "not " unless unpack("s", pack("s", -32768)) == -32768; +print "ok ", $test++, "\n"; print "not " unless unpack("S", pack("S", 65535)) == 65535; print "ok ", $test++, "\n"; @@ -325,18 +316,8 @@ print "ok ", $test++, "\n"; print "not " unless unpack("l", pack("l", 2147483647)) == 2147483647; print "ok ", $test++, "\n"; -if ($Config{longsize} == 4 || $Config{byteorder} eq '12345678') { - print "not " unless unpack("l", pack("l", -2147483648)) == -2147483648; - print "ok ", $test++, "\n"; -} else { - if ($Config{shortsize} == 8 && $Config{byteorder} eq '87654321') { - print "not " - unless unpack("l_", pack("l_", -2147483648)) == -2147483648; - print "ok ", $test++, "\n"; - } else { - print "ok ", $test++, " # skipped\n"; - } -} +print "not " unless unpack("l", pack("l", -2147483648)) == -2147483648; +print "ok ", $test++, "\n"; print "not " unless unpack("L", pack("L", 4294967295)) == 4294967295; print "ok ", $test++, "\n"; @@ -344,66 +325,33 @@ print "ok ", $test++, "\n"; print "not " unless unpack("n", pack("n", 65535)) == 65535; print "ok ", $test++, "\n"; -if ($Config{shortsize} == 2) { - print "not " unless unpack("v", pack("v", 65535)) == 65535; - print "ok ", $test++, "\n"; -} else { - print "ok ", $test++, " # skipped\n"; -} +print "not " unless unpack("v", pack("v", 65535)) == 65535; +print "ok ", $test++, "\n"; print "not " unless unpack("N", pack("N", 4294967295)) == 4294967295; print "ok ", $test++, "\n"; -if ($Config{longsize} == 4 || $Config{byteorder} eq '12345678') { - print "not " unless unpack("V", pack("V", 4294967295)) == 4294967295; - print "ok ", $test++, "\n"; -} else { - print "ok ", $test++, " # skipped\n"; -} +print "not " unless unpack("V", pack("V", 4294967295)) == 4294967295; +print "ok ", $test++, "\n"; # 95..98 test the n/v/N/V byteorder if ($Config{byteorder} =~ /^1234(5678)?$/ || $Config{byteorder} =~ /^(8765)?4321$/) { - if ($Config{shortsize} == 2 || - $Config{byteorder} eq '87654321') { - print "not " unless pack("n", 0xdead) eq "\xde\xad"; - print "ok ", $test++, "\n"; - - if ($Config{byteorder} ne '87654321') { - print "not " unless pack("v", 0xdead) eq "\xad\xde"; - print "ok ", $test++, "\n"; - } else { - print "ok ", $test++, " # skipped\n"; - } - } else { - # shortsize != 2 systems require more thought - foreach (95..96) { - print "ok ", $test++, " # skipped\n"; - } - } - - if ($Config{longsize} == 4 || - $Config{byteorder} eq '12345678' || - $Config{byteorder} eq '87654321') { - print "not " unless pack("N", 0xdeadbeef) eq "\xde\xad\xbe\xef"; - print "ok ", $test++, "\n"; - - if ($Config{byteorder} ne '87654321') { - print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde"; - print "ok ", $test++, "\n"; - } else { - print "ok ", $test++, " # skipped\n"; - } - } else { - # exotic longsize != 2 systems require more thought - foreach (97..98) { - print "ok ", $test++, " # skipped\n"; - } - } + print "not " unless pack("n", 0xdead) eq "\xde\xad"; + print "ok ", $test++, "\n"; + + print "not " unless pack("v", 0xdead) eq "\xad\xde"; + print "ok ", $test++, "\n"; + + print "not " unless pack("N", 0xdeadbeef) eq "\xde\xad\xbe\xef"; + print "ok ", $test++, "\n"; + + print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde"; + print "ok ", $test++, "\n"; } else { - # exotic byteorder system require more thought + # exotic byteorder systems require more thought foreach (95..98) { print "ok ", $test++, " # skipped\n"; }