develooper Front page | perl.perl5.porters | Postings from August 2001

[PATCH] pass all tests when compiling with -DNO_PERL_PRESERVE_IVUV

From:
Nicholas Clark
Date:
August 29, 2001 10:21
Subject:
[PATCH] pass all tests when compiling with -DNO_PERL_PRESERVE_IVUV
Message ID:
20010829182156.O4950@plum.flirble.org
Do we want perl to pass all regression tests when built with
-DNO_PERL_PRESERVE_IVUV in the cflags (ie use NVs only for arithmetic and
comparison operations, rather than the complex IV-NV code)

If so, following patch is needed.
Passes 100% with -DNO_PERL_PRESERVE_IVUV for -U/Duse64bitint and
-U/Dlongdoubles with cflags including -DNO_PERL_PRESERVE_IVUV, and
doesn't break default build.

Nicholas Clark

--- sv.c.orig	Mon Aug 27 17:20:23 2001
+++ sv.c	Wed Aug 29 16:03:37 2001
@@ -2628,10 +2628,10 @@
     }
     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 @@
     }
     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 @@
     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);
--- ext/Devel/Peek/Peek.t.orig	Mon Jun 18 06:21:15 2001
+++ ext/Devel/Peek/Peek.t	Tue Aug 28 22:38:28 2001
@@ -33,6 +33,7 @@
 	    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 @@
   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 @@
     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 @@
       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 @@
     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(){@_},
--- t/op/numconvert.t.orig	Mon Jul  2 20:17:12 2001
+++ t/op/numconvert.t	Wed Aug 29 16:01:37 2001
@@ -48,9 +48,11 @@
 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);
@@ -58,6 +60,10 @@
       print " (common in 64-bit platforms)";
   }
   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;
 }
 
--- t/op/64bitint.t.orig	Wed Aug 22 21:31:57 2001
+++ t/op/64bitint.t	Tue Aug 28 21:55:07 2001
@@ -14,10 +14,26 @@
 
 # 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 @@
 
 # 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";



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