pass all tests when compiling with -DNO_PERL_PRESERVE_IVUV

Message-Id: <20010829182156.O4950@plum.flirble.org>

p4raw-id: //depot/perl@11788

diff --git a/ext/Devel/Peek/Peek.t b/ext/Devel/Peek/Peek.t
index c14dc9b..be7bf82 100644 (file)
--- a/ext/Devel/Peek/Peek.t
+++ b/ext/Devel/Peek/Peek.t
@@ -33,6 +33,7 @@ sub do_test {
            print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
            print "ok $_[0]\n";
            close(IN);
+            return $1;
        } else {
            die "$0: failed to open peek$$: !\n";
        }
@@ -86,12 +87,17 @@ do_test( 5,
   FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
   IV = 456');
 
-do_test( 6,
+# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
+# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
+# maths is done in floating point always, and this scalar will be an NV.
+# ([NI]) captures the type, referred to by \1 in this regexp and $type for
+# building subsequent regexps.
+my $type = do_test( 6,
         $c + $d,
-'SV = IV\\($ADDR\\) at $ADDR
+'SV = ([NI])V\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\(PADTMP,IOK,pIOK\\)
-  IV = 456');
+  FLAGS = \\(PADTMP,\1OK,p\1OK\\)
+  \1V = 456');
 
 ($d = "789") += 0.1;
 
@@ -132,6 +138,22 @@ do_test(10,
     CUR = 3
     LEN = 4');
 
+my $c_pattern;
+if ($type eq 'N') {
+  $c_pattern = '
+    SV = PVNV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
+      IV = 456
+      NV = 456
+      PV = 0';
+} else {
+  $c_pattern = '
+    SV = IV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,pIOK\\)
+      IV = 456';
+}
 do_test(11,
        [$b,$c],
 'SV = RV\\($ADDR\\) at $ADDR
@@ -153,11 +175,7 @@ do_test(11,
       REFCNT = 1
       FLAGS = \\(IOK,pIOK\\)
       IV = 123
-    Elt No. 1
-    SV = IV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(IOK,pIOK\\)
-      IV = 456');
+    Elt No. 1' . $c_pattern);
 
 do_test(12,
        {$b=>$c},
@@ -177,11 +195,7 @@ do_test(12,
     MAX = 7
     RITER = -1
     EITER = 0x0
-    Elt "123" HASH = $ADDR
-    SV = IV\\($ADDR\\) at $ADDR
-      REFCNT = 1
-      FLAGS = \\(IOK,pIOK\\)
-      IV = 456');
+    Elt "123" HASH = $ADDR' . $c_pattern);
 
 do_test(13,
         sub(){@_},

diff --git a/sv.c b/sv.c
index 744083a..cd89509 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2628,10 +2628,10 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     }
     else if (SvTYPE(sv) < SVt_PVNV)
        sv_upgrade(sv, SVt_PVNV);
-    if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) {
-       SvNOK_on(sv);
+    if (SvNOKp(sv)) {
+        return SvNVX(sv);
     }
-    else if (SvIOKp(sv)) {
+    if (SvIOKp(sv)) {
        SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
 #ifdef NV_PRESERVES_UV
        SvNOK_on(sv);
@@ -5829,7 +5829,9 @@ Perl_sv_inc(pTHX_ register SV *sv)
     }
     if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
        /* It's publicly an integer, or privately an integer-not-float */
+#ifdef PERL_PRESERVE_IVUV
       oops_its_int:
+#endif
        if (SvIsUV(sv)) {
            if (SvUVX(sv) == UV_MAX)
                sv_setnv(sv, (NV)UV_MAX + 1.0);
@@ -5977,7 +5979,9 @@ Perl_sv_dec(pTHX_ register SV *sv)
     flags = SvFLAGS(sv);
     if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
        /* It's publicly an integer, or privately an integer-not-float */
+#ifdef PERL_PRESERVE_IVUV
       oops_its_int:
+#endif
        if (SvIsUV(sv)) {
            if (SvUVX(sv) == 0) {
                (void)SvIOK_only(sv);

diff --git a/t/op/64bitint.t b/t/op/64bitint.t
index e5ff95b..92b00d7 100644 (file)
--- a/t/op/64bitint.t
+++ b/t/op/64bitint.t
@@ -14,10 +14,26 @@ BEGIN {
 
 # so that using > 0xfffffff constants and
 # 32+ bit integers don't cause noise
+use warnings;
 no warnings qw(overflow portable);
 
 print "1..59\n";
 
+# as 6 * 6 = 36, the last digit of 6**n will always be six. Hence the last
+# digit of 16**n will always be six. Hence 16**n - 1 will always end in 5.
+# Assumption is that UVs will always be a multiple of 4 bits long.
+
+my $UV_max = ~0;
+die "UV_max eq '$UV_max', doesn't end in 5; your UV isn't 4n bits long :-(."
+  unless $UV_max =~ /5$/;
+my $UV_max_less3 = $UV_max - 3;
+my $maths_preserves_UVs = $UV_max_less3 =~ /^\d+2$/;   # 5 - 3 is 2.
+if ($maths_preserves_UVs) {
+  print "# This perl's maths preserves all bits of a UV.\n";
+} else {
+  print "# This perl's maths does not preserve all bits of a UV.\n";
+}
+
 my $q = 12345678901;
 my $r = 23456789012;
 my $f = 0xffffffff;
@@ -327,7 +343,8 @@ print "ok 58\n";
 
 # 0xFFFFFFFFFFFFFFFF ==  1 * 3 * 5 * 17 * 257 * 641 * 65537 * 6700417'
 $q = 0xFFFFFFFFFFFFFFFF / 3;
-if ($q == 0x5555555555555555 and $q != 0x5555555555555556) {
+if ($q == 0x5555555555555555 and ($q != 0x5555555555555556
+                                  or !$maths_preserves_UVs)) {
   print "ok 59\n";
 } else {
   print "not ok 59 # 0xFFFFFFFFFFFFFFFF / 3 = $q\n";

diff --git a/t/op/numconvert.t b/t/op/numconvert.t
index 084092e..fedef70 100755 (executable)
--- a/t/op/numconvert.t
+++ b/t/op/numconvert.t
@@ -48,9 +48,11 @@ my $max_chain = $ENV{PERL_TEST_NUMCONVERTS} || 2;
 my $max_uv1 = ~0;
 my $max_uv2 = sprintf "%u", $max_uv1 ** 6; # 6 is an arbitrary number here
 my $big_iv = do {use integer; $max_uv1 * 16}; # 16 is an arbitrary number here
+my $max_uv_less3 = $max_uv1 - 3;
 
 print "# max_uv1 = $max_uv1, max_uv2 = $max_uv2, big_iv = $big_iv\n";
-if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) {
+print "# max_uv_less3 = $max_uv_less3\n";
+if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1 or $max_uv1 == $max_uv_less3) {
   print "1..0 # skipped: unsigned perl arithmetic is not sane";
   eval { require Config; import Config };
   use vars qw(%Config);
@@ -60,6 +62,10 @@ if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) {
   print "\n";
   exit 0;
 }
+if ($max_uv_less3 =~ tr/0-9//c) {
+  print "1..0 # skipped: this perl stringifies large unsigned integers using E notation\n";
+  exit 0;
+}
 
 my $st_t = 4*4;                        # We try 4 initializers and 4 reporters