Change 15287 by jhi@alpha on 2002/03/18 13:40:28
Subject: [PATCH] another pack "w" thing
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Sat, 16 Mar 2002 21:52:15 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/pp_pack.c#23 edit
.... //depot/perl/t/op/pack.t#68 edit
Differences ...
==== //depot/perl/pp_pack.c#23 (text) ====
Index: perl/pp_pack.c
--- perl/pp_pack.c.~1~ Mon Mar 18 06:45:05 2002
+++ perl/pp_pack.c Mon Mar 18 06:45:05 2002
@@ -2163,26 +2163,21 @@
case 'w':
while (len-- > 0) {
fromstr = NEXTFROM;
- adouble = Perl_floor(SvNV(fromstr));
+ adouble = SvNV(fromstr);
if (adouble < 0)
Perl_croak(aTHX_ "Cannot compress negative numbers");
- if (
-#if UVSIZE > 4 && UVSIZE >= NVSIZE
- adouble <= 0xffffffff
-#else
-# ifdef CXUX_BROKEN_CONSTANT_CONVERT
- adouble <= UV_MAX_cxux
-# else
- adouble <= UV_MAX
-# endif
-#endif
- )
+ /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0,
+ which is == UV_MAX_P1. IOK is fine (instead of UV_only), as
+ any negative IVs will have already been got by the croak()
+ above. IOK is untrue for fractions, so we test them
+ against UV_MAX_P1. */
+ if (SvIOK(fromstr) || adouble < UV_MAX_P1)
{
char buf[1 + sizeof(UV)];
char *in = buf + sizeof(buf);
- UV auv = U_V(adouble);
+ UV auv = SvUV(fromstr);
do {
*--in = (auv & 0x7f) | 0x80;
@@ -2216,6 +2211,7 @@
char buf[sizeof(double) * 2]; /* 8/7 <= 2 */
char *in = buf + sizeof(buf);
+ adouble = Perl_floor(adouble);
do {
double next = floor(adouble / 128);
*--in = (unsigned char)(adouble - (next * 128)) | 0x80;
==== //depot/perl/t/op/pack.t#68 (xtext) ====
Index: perl/t/op/pack.t
--- perl/t/op/pack.t.~1~ Mon Mar 18 06:45:05 2002
+++ perl/t/op/pack.t Mon Mar 18 06:45:05 2002
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 5619;
+plan tests => 5625;
use strict;
use warnings;
@@ -122,11 +122,28 @@
$y = pack('w*', Math::BigInt::->new(5000000000));
};
is($x, $y);
+
+ $x = pack 'w', ~0;
+ $y = pack 'w', (~0).'';
+ is($x, $y);
+ is(unpack ('w',$x), ~0);
+ is(unpack ('w',$y), ~0);
+
+ $x = pack 'w', ~0 - 1;
+ $y = pack 'w', (~0) - 2;
+
+ if (~0 - 1 == (~0) - 2) {
+ is($x, $y, "NV arithmetic");
+ } else {
+ isnt($x, $y, "IV/NV arithmetic");
+ }
+ cmp_ok(unpack ('w',$x), '==', ~0 - 1);
+ cmp_ok(unpack ('w',$y), '==', ~0 - 2);
}
{
- # test exeptions
+ # test exceptions
my $x;
eval { $x = unpack 'w', pack 'C*', 0xff, 0xff};
like($@, qr/^Unterminated compressed integer/);
End of Patch.
