Change 11788 by ams@ams-lustre on 2001/08/29 17:35:33
Subject: [PATCH] pass all tests when compiling with -DNO_PERL_PRESERVE_IVUV
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Wed, 29 Aug 2001 18:21:56 +0100
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/Devel/Peek/Peek.t#2 edit
... //depot/perl/sv.c#460 edit
... //depot/perl/t/op/64bitint.t#11 edit
... //depot/perl/t/op/numconvert.t#12 edit
Differences ...
==== //depot/perl/ext/Devel/Peek/Peek.t#2 (text) ====
Index: perl/ext/Devel/Peek/Peek.t
--- perl/ext/Devel/Peek/Peek.t.~1~ Wed Aug 29 11:45:05 2001
+++ perl/ext/Devel/Peek/Peek.t Wed Aug 29 11:45:05 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(){@_},
==== //depot/perl/sv.c#460 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Wed Aug 29 11:45:05 2001
+++ perl/sv.c Wed Aug 29 11:45:05 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);
==== //depot/perl/t/op/64bitint.t#11 (text) ====
Index: perl/t/op/64bitint.t
--- perl/t/op/64bitint.t.~1~ Wed Aug 29 11:45:05 2001
+++ perl/t/op/64bitint.t Wed Aug 29 11:45:05 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";
==== //depot/perl/t/op/numconvert.t#12 (xtext) ====
Index: perl/t/op/numconvert.t
--- perl/t/op/numconvert.t.~1~ Wed Aug 29 11:45:05 2001
+++ perl/t/op/numconvert.t Wed Aug 29 11:45:05 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);
@@ -60,6 +62,10 @@
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
End of Patch.
