develooper Front page | perl.perl5.porters | Postings from May 2002

[PATCH] pack 'w' should be using NV, not double

Thread Next
From:
Nicholas Clark
Date:
May 29, 2002 07:38
Subject:
[PATCH] pack 'w' should be using NV, not double
Message ID:
20020529153840.L53388@plum.flirble.org
I'm finding it very hard to make a regression test that fails for this
one on a normal long double/use64bitint build. I can get t/op/pack.t
to fail 3 tests if I build with -DNO_PERL_PRESERVE_IVUV (which is how
I found the problem) but although I believe I should be able to contrive
a test that fails without that (probably on 32 bit IVs with long doubles),
but I've not managed.

With -DNO_PERL_PRESERVE_IVUV t/op/pack.t fails this section:

    $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);

like this (run through less - the <> and ^ notation makes otherwise
unprintable characters visible:

# Failed at t/op/pack.t line 138
# it should not be '<82><80><80><80><80><80><80><80><80>^@'
# but it is.
# Failed at t/op/pack.t line 140
#      got '18446744073709551616'
# expected == '1.84467440737095516e+19'
# Failed at t/op/pack.t line 141
#      got '18446744073709551616'
# expected == '1.84467440737095516e+19'

not ok 28 - IV/NV arithmetic
not ok 29
not ok 30


Patch appended corrects this, causes no other configurations
({32,64} bit IVs * {doubles,long double} * {,-DNO_PERL_PRESERVE_IVUV})
to fail any tests.

Nicholas Clark

--- pp_pack.c.orig	Sun Apr 21 21:59:10 2002
+++ pp_pack.c	Tue May 28 21:13:05 2002
@@ -2232,9 +2232,9 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, 
 	case 'w':
             while (len-- > 0) {
 		fromstr = NEXTFROM;
-		adouble = SvNV(fromstr);
+		anv = SvNV(fromstr);
 
-		if (adouble < 0)
+		if (anv < 0)
 		    Perl_croak(aTHX_ "Cannot compress negative numbers");
 
                 /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0,
@@ -2242,7 +2242,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, 
                    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)
+		if (SvIOK(fromstr) || anv < UV_MAX_P1)
 		{
 		    char   buf[(sizeof(UV)*8)/7+1];
 		    char  *in = buf + sizeof(buf);
@@ -2277,17 +2277,17 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, 
 		    SvREFCNT_dec(norm);	/* free norm */
                 }
 		else if (SvNOKp(fromstr)) {
-		    char   buf[sizeof(double) * 2];	/* 8/7 <= 2 */
+		    char   buf[sizeof(NV) * 2];	/* 8/7 <= 2 */
 		    char  *in = buf + sizeof(buf);
 
-                    adouble = Perl_floor(adouble);
+                    anv = Perl_floor(anv);
 		    do {
-			double next = floor(adouble / 128);
-			*--in = (unsigned char)(adouble - (next * 128)) | 0x80;
+			NV next = Perl_floor(anv / 128);
+			*--in = (unsigned char)(anv - (next * 128)) | 0x80;
 			if (in <= buf)  /* this cannot happen ;-) */
 			    Perl_croak(aTHX_ "Cannot compress integer");
-			adouble = next;
-		    } while (adouble > 0);
+			anv = next;
+		    } while (anv > 0);
 		    buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
 		    sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
 		}

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About