From: Nicholas Clark Date: Wed, 29 Aug 2001 18:21:56 +0000 (+0100) Subject: pass all tests when compiling with -DNO_PERL_PRESERVE_IVUV X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=59d8ce6297a94889161c3324ccfdc9bb1a2d9d05;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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