overload "0+" doesn't handle integer results #9047
Comments
From zefram@fysh.orgCreated by zefram@fysh.orgThis perl is configured with 64-bit integers and 64-bit floats (1+52 $ perl -lwe '{ package t0; sub mynum { 36028797018963971 } use overload "0+" => \&mynum; } print int(t0::mynum); print int(bless({}, "t0"))' 36028797018963971 is 2^55+3. Its salient feature here is that it's Perl Info |
From rick@bort.caOn Oct 02 2007, Zefram wrote:
The problem here is that the arg passed to int() is checked if IOK -- |
From rick@bort.ca46011.patchdiff -pruN perl-current/lib/overload.t perl-current-dev/lib/overload.t
--- perl-current/lib/overload.t 2007-10-03 16:46:52.000000000 -0400
+++ perl-current-dev/lib/overload.t 2007-10-06 20:55:19.000000000 -0400
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not need
package main;
$| = 1;
-use Test::More tests => 528;
+use Test::More tests => 535;
$a = new Oscalar "087";
@@ -1375,3 +1375,28 @@ foreach my $op (qw(<=> == != < <= > >=))
is("$wham_eth", $string);
is ($crunch_eth->Pie("Blackbird"), "$string, Blackbird");
}
+
+{
+ package numify_int;
+ use overload "0+" => sub { $_[0][0] += 1; 42 };
+ package numify_self;
+ use overload "0+" => sub { $_[0][0]++; $_[0] };
+ package numify_other;
+ use overload "0+" => sub { $_[0][0]++; $_[0][1] = bless [], 'numify_int' };
+
+ package main;
+ my $o = bless [], 'numify_int';
+ is(int($o), 42, 'numifies to integer');
+ is($o->[0], 1, 'int() numifies only once');
+
+ my $aref = [];
+ my $num_val = 0 + $aref;
+ my $r = bless $aref, 'numify_self';
+ is(int($r), $num_val, 'numifies to self');
+ is($r->[0], 1, 'int() numifies once when returning self');
+
+ my $s = bless [], 'numify_other';
+ is(int($s), 42, 'numifies to numification of other object');
+ is($s->[0], 1, 'int() numifies once when returning other object');
+ is($s->[1][0], 1, 'returned object numifies too');
+}
diff -pruN perl-current/pp.c perl-current-dev/pp.c
--- perl-current/pp.c 2007-09-08 16:48:36.000000000 -0400
+++ perl-current-dev/pp.c 2007-10-06 21:48:35.000000000 -0400
@@ -2874,22 +2874,38 @@ PP(pp_int)
{
dVAR; dSP; dTARGET; tryAMAGICun(int);
{
- const IV iv = TOPi; /* attempt to convert to IV if possible. */
+ SV *sv = TOPs;
+ IV iv;
/* XXX it's arguable that compiler casting to IV might be subtly
different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
else preferring IV has introduced a subtle behaviour change bug. OTOH
relying on floating point to be accurate is a bug. */
- if (!SvOK(TOPs))
+ while (SvAMAGIC(sv)) {
+ SV *tsv = AMG_CALLun(sv,numer);
+ if (SvROK(tsv) && SvRV(tsv) == SvRV(sv)) {
+ SETi(PTR2IV(SvRV(sv)));
+ RETURN;
+ }
+ else
+ sv = tsv;
+ }
+ iv = SvIV(sv); /* attempt to convert to IV if possible. */
+
+ if (!SvOK(sv)) {
SETu(0);
- else if (SvIOK(TOPs)) {
- if (SvIsUV(TOPs)) {
- const UV uv = TOPu;
- SETu(uv);
- } else
+ }
+ else if (SvIOK(sv)) {
+ if (SvIsUV(sv))
+ SETu(SvUV(sv));
+ else
SETi(iv);
- } else {
- const NV value = TOPn;
+ }
+ else if (SvROK(sv)) {
+ SETi(iv);
+ }
+ else {
+ const NV value = SvNV(sv);
if (value >= 0.0) {
if (value < (NV)UV_MAX + 0.5) {
SETu(U_V(value));
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @rgsOn 07/10/2007, Rick Delaney <rick@bort.ca> wrote:
Thanks, applied as change #32059, and I confirmed that fixes the bug |
|
@rgs - Status changed from 'open' to 'resolved' |
From @jdheddenRick Delaney wrote:
Rafael Garcia-Suarez wrote:
This is the same bug as reported by me exactly 2 years ago: Rafael, would you please resolve bug 37363 (or whatever is |
From zefram@fysh.orgRafael Garcia-Suarez via RT wrote:
I looked up the patch that was posted to perl5-porters, and it solves $ perl -lwe '{ package t0; sub mynum { 36028797018963971 } use overload "0+" => \&mynum, fallback => 1; } printf "%d\n", 0+t0::mynum; printf "%d\n", 0+bless({}, "t0")' It works OK for plain printf "%d", but not for addition. Also doesn't -zefram |
From rick@bort.caOn Oct 07 2007, Zefram wrote:
I wish you'd mentioned that before.
Undoubtedly. In the meantime here is another patch to fix a segfault -- |
From rick@bort.ca46011-a.patchdiff -pruN perl-current/lib/overload.t perl-current-dev/lib/overload.t
--- perl-current/lib/overload.t 2007-10-07 05:48:30.000000000 -0400
+++ perl-current-dev/lib/overload.t 2007-10-07 22:20:43.000000000 -0400
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not need
package main;
$| = 1;
-use Test::More tests => 535;
+use Test::More tests => 536;
$a = new Oscalar "087";
@@ -1383,6 +1383,8 @@ foreach my $op (qw(<=> == != < <= > >=))
use overload "0+" => sub { $_[0][0]++; $_[0] };
package numify_other;
use overload "0+" => sub { $_[0][0]++; $_[0][1] = bless [], 'numify_int' };
+ package numify_by_fallback;
+ use overload "-" => sub { 1 }, fallback => 1;
package main;
my $o = bless [], 'numify_int';
@@ -1399,4 +1401,7 @@ foreach my $op (qw(<=> == != < <= > >=))
is(int($s), 42, 'numifies to numification of other object');
is($s->[0], 1, 'int() numifies once when returning other object');
is($s->[1][0], 1, 'returned object numifies too');
+
+ my $m = bless $aref, 'numify_by_fallback';
+ is(int($m), $num_val, 'numifies to usual reference value');
}
diff -pruN perl-current/pp.c perl-current-dev/pp.c
--- perl-current/pp.c 2007-10-07 05:48:30.000000000 -0400
+++ perl-current-dev/pp.c 2007-10-07 22:20:10.000000000 -0400
@@ -2883,6 +2883,8 @@ PP(pp_int)
while (SvAMAGIC(sv)) {
SV *tsv = AMG_CALLun(sv,numer);
+ if (!tsv)
+ break;
if (SvROK(tsv) && SvRV(tsv) == SvRV(sv)) {
SETi(PTR2IV(SvRV(sv)));
RETURN;
|
From @rgsOn 08/10/2007, Rick Delaney <rick@bort.ca> wrote:
Thanks, applied. |
From @rgsOn 08/10/2007, Rafael Garcia-Suarez <rgarciasuarez@gmail.com> wrote:
From the smoke tests, it seems that test 531 fails for builds with |
From @TuxOn Mon, 8 Oct 2007 14:01:02 +0200, "Rafael Garcia-Suarez"
Smoke [5.10.0] 32059 FAIL(F) hp-ux B.11.23/64 gcc (ia64/2 cpu)
I did two manual runs with -Duse64bitall on 32068 Linux 2.6.18.8-0.5 x86_64 Xeon(R) CPU E5320 @ 1.86GHz/1596(4) x86_64 3951 Mb All tests successful, 70 tests and 758 subtests skipped. HP-UX 11.23/64 U rx1620/64 Itanium 2/1600(2) ia64 2037 Mb Failed Test Stat Wstat Total Fail List of Failed ../lib/overload.t 2 512 536 2 531 536 x1:/pro/3gl/CPAN/perl-current/t 112 > ./perl -I../lib ../lib/overload.t On a side note, I don't like messages like this: ../lib/Module/Build/t/ppm........................................ok 2/12Invalid header block at offset unknown at ../lib/Module/Build/t/ppm.t line 122 Can't those be silenced? -- |
From jos@dwim.orgOn 08 Oct 2007, at 14:18, H.Merijn Brand wrote:
They can be by setting C<$Archive::Tar::WARN = 0>, however you probably This may point to a more serious issue underneath. -- Jos Boumans How do I prove I'm not crazy to people who are? |
From @jdheddenZefram wrote:
The attached patch adds tests for these to lib/overload.t. |
From @jdheddenol64.patch--- perl-current/lib/overload.t
+++ perl-current/lib/overload.t
@@ -47,7 +47,7 @@
package main;
$| = 1;
-use Test::More tests => 536;
+use Test::More tests => 563;
$a = new Oscalar "087";
@@ -1405,3 +1405,83 @@
my $m = bless $aref, 'numify_by_fallback';
is(int($m), $num_val, 'numifies to usual reference value');
}
+
+SKIP: {
+ skip('64-bit int tests on 32-bit Perl', 12)
+ if ($Config::Config{'uvsize'} != 8);
+
+ my $ii = 36028797018963971; # 2^55 + 3
+
+ package Oobj;
+ use overload '0+' => sub { ${$_[0]} += 1; $ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj') }
+
+ package main;
+ my $oo = Oobj->new();
+ my $cnt = 1;
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(0+$oo, 0+$ii, '0+ overload on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ is("$oo", "$ii", '0+ overload with stringification on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(0-$oo, 0-$ii, '0+ overload with subtraction on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(2*$oo, 2*$ii, '0+ overload with multiplication on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo/1, $ii/1, '0+ overload with division on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo%100, $ii%100, '0+ overload with modulo on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo**1, $ii**1, '0+ overload with exponentiation on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo>>3, $ii>>3, '0+ overload with bit shift right on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo<<2, $ii<<2, '0+ overload with bit shift left on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ ok($oo == $ii, '0+ overload with equality on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(int($oo), $ii, '0+ overload with int() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ }
+}
+
+# EOF
|
From @jdhedden
Ticket should be reopened because the above still need fixing. |
From rick@bort.caOn Oct 08 2007, H.Merijn Brand wrote:
The expected value is just my $aref = []; So it means that a regular reference in numeric context is returning an I'm pretty sure changing the line to my $num_val = int($aref); will make the tests pass without changing the semantic of the test too -- |
From @rgsOn 08/10/2007, Rick Delaney <rick@bort.ca> wrote:
Thanks, tweaked as #32071.
I think IVs are guaranteed to be able to hold pointers. |
From @jdheddenZefram wrote:
Jerry D. Hedden wrote:
Programming by example, the attached patch fixes the above |
From @jdheddenabs.patch--- perl-current/pp.c
+++ perl-current/pp.c
@@ -2931,16 +2931,35 @@
{
dVAR; dSP; dTARGET; tryAMAGICun(abs);
{
- /* This will cache the NV value if string isn't actually integer */
- const IV iv = TOPi;
+ SV *sv = TOPs;
+ IV iv;
- if (!SvOK(TOPs))
+ while (SvAMAGIC(sv)) {
+ SV *tsv = AMG_CALLun(sv,numer);
+ if (!tsv)
+ break;
+ if (SvROK(tsv) && SvRV(tsv) == SvRV(sv)) {
+ SETi(PTR2IV(SvRV(sv)));
+ RETURN;
+ }
+ else
+ sv = tsv;
+ }
+ iv = SvIV(sv); /* attempt to convert to IV if possible. */
+
+ if (!SvOK(sv)) {
SETu(0);
- else if (SvIOK(TOPs)) {
+ }
+ else if (SvIOK(sv)) {
/* IVX is precise */
- if (SvIsUV(TOPs)) {
- SETu(TOPu); /* force it to be numeric only */
+ if (SvIsUV(sv)) {
+ SETu(SvUV(sv)); /* force it to be numeric only */
} else {
+ goto do_abs;
+ }
+ }
+ else if (SvROK(sv)) {
+ do_abs:
if (iv >= 0) {
SETi(iv);
} else {
@@ -2952,9 +2971,9 @@
SETu(IV_MIN);
}
}
- }
- } else{
- const NV value = TOPn;
+ }
+ else {
+ const NV value = SvNV(sv);
if (value < 0.0)
SETn(-value);
else
--- perl-current/lib/overload.t
+++ perl-current/lib/overload.t
@@ -47,7 +47,7 @@
package main;
$| = 1;
-use Test::More tests => 536;
+use Test::More tests => 570;
$a = new Oscalar "087";
@@ -1392,7 +1392,7 @@
is($o->[0], 1, 'int() numifies only once');
my $aref = [];
- my $num_val = int($aref);
+ my $num_val = 0 + $aref;
my $r = bless $aref, 'numify_self';
is(int($r), $num_val, 'numifies to self');
is($r->[0], 1, 'int() numifies once when returning self');
@@ -1405,3 +1405,112 @@
my $m = bless $aref, 'numify_by_fallback';
is(int($m), $num_val, 'numifies to usual reference value');
}
+
+SKIP: {
+ skip('64-bit int tests on 32-bit Perl', 12)
+ if ($Config::Config{'uvsize'} != 8);
+
+ my $ii = 36028797018963971; # 2^55 + 3
+
+ package Oobj;
+ use overload '0+' => sub { ${$_[0]} += 1; $ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj') }
+
+ package main;
+ my $oo = Oobj->new();
+ my $cnt = 1;
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(0+$oo, 0+$ii, '0+ overload on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ is("$oo", "$ii", '0+ overload with stringification on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(0-$oo, 0-$ii, '0+ overload with subtraction on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(2*$oo, 2*$ii, '0+ overload with multiplication on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo/1, $ii/1, '0+ overload with division on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo%100, $ii%100, '0+ overload with modulo on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo**1, $ii**1, '0+ overload with exponentiation on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo>>3, $ii>>3, '0+ overload with bit shift right on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo<<2, $ii<<2, '0+ overload with bit shift left on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ ok($oo == $ii, '0+ overload with equality on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(int($oo), $ii, '0+ overload with int() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+
+ ### Tests with large negative int
+ package Oobj2;
+ use overload '0+' => sub { ${$_[0]} += 1; 0-$ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj2') }
+
+ package main;
+ $oo = Oobj2->new();
+ $cnt = 1;
+
+ is(int($oo), 0-$ii, '0+ overload with int() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+
+ ### Tests with 'abs' overloading
+ package Oobj3;
+ use overload 'abs' => sub { ${$_[0]} += 1; $ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj3') }
+
+ package main;
+ $oo = Oobj3->new();
+ $cnt = 1;
+
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+}
+
+# EOF
|
From @jdheddenZefram wrote:
Jerry D. Hedden wrote:
The attached patch (which supercedes my previous patches on The patch can be check using the following: ./perl -Ilib -lwe '{ package t0; sub mynum { -36028797018963971 } use ./perl -Ilib -lwe '{ package t0; sub mynum { -36028797018963971 } use |
From @jdheddenoverload.patch--- perl-current/pp.c
+++ perl-current/pp.c
@@ -2374,7 +2374,21 @@
dVAR; dSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
- const int flags = SvFLAGS(sv);
+ int flags;
+
+ while (SvAMAGIC(sv)) {
+ SV *tsv = AMG_CALLun(sv,numer);
+ if (!tsv)
+ break;
+ if (SvROK(tsv) && SvRV(tsv) == SvRV(sv)) {
+ SETi(-PTR2IV(SvRV(sv)));
+ RETURN;
+ }
+ else
+ sv = tsv;
+ }
+
+ flags = SvFLAGS(sv);
SvGETMAGIC(sv);
if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
/* It's publicly an integer, or privately an integer-not-float */
@@ -2874,7 +2888,7 @@
{
dVAR; dSP; dTARGET; tryAMAGICun(int);
{
- SV *sv = TOPs;
+ dTOPss;
IV iv;
/* XXX it's arguable that compiler casting to IV might be subtly
different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
@@ -2931,16 +2945,35 @@
{
dVAR; dSP; dTARGET; tryAMAGICun(abs);
{
- /* This will cache the NV value if string isn't actually integer */
- const IV iv = TOPi;
+ dTOPss;
+ IV iv;
+
+ while (SvAMAGIC(sv)) {
+ SV *tsv = AMG_CALLun(sv,numer);
+ if (!tsv)
+ break;
+ if (SvROK(tsv) && SvRV(tsv) == SvRV(sv)) {
+ SETi(PTR2IV(SvRV(sv)));
+ RETURN;
+ }
+ else
+ sv = tsv;
+ }
+ iv = SvIV(sv); /* attempt to convert to IV if possible. */
- if (!SvOK(TOPs))
+ if (!SvOK(sv)) {
SETu(0);
- else if (SvIOK(TOPs)) {
+ }
+ else if (SvIOK(sv)) {
/* IVX is precise */
- if (SvIsUV(TOPs)) {
- SETu(TOPu); /* force it to be numeric only */
+ if (SvIsUV(sv)) {
+ SETu(SvUV(sv)); /* force it to be numeric only */
} else {
+ goto do_abs;
+ }
+ }
+ else if (SvROK(sv)) {
+ do_abs:
if (iv >= 0) {
SETi(iv);
} else {
@@ -2952,9 +2985,9 @@
SETu(IV_MIN);
}
}
- }
- } else{
- const NV value = TOPn;
+ }
+ else {
+ const NV value = SvNV(sv);
if (value < 0.0)
SETn(-value);
else
--- perl-current/lib/overload.t
+++ perl-current/lib/overload.t
@@ -47,7 +47,7 @@
package main;
$| = 1;
-use Test::More tests => 536;
+use Test::More tests => 580;
$a = new Oscalar "087";
@@ -1392,7 +1392,7 @@
is($o->[0], 1, 'int() numifies only once');
my $aref = [];
- my $num_val = int($aref);
+ my $num_val = 0 + $aref;
my $r = bless $aref, 'numify_self';
is(int($r), $num_val, 'numifies to self');
is($r->[0], 1, 'int() numifies once when returning self');
@@ -1405,3 +1405,138 @@
my $m = bless $aref, 'numify_by_fallback';
is(int($m), $num_val, 'numifies to usual reference value');
}
+
+SKIP: {
+ skip('64-bit int tests on 32-bit Perl', 12)
+ if ($Config::Config{'uvsize'} != 8);
+
+ my $ii = 36028797018963971; # 2^55 + 3
+
+ package Oobj;
+ use overload '0+' => sub { ${$_[0]} += 1; $ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj') }
+
+ package main;
+ my $oo = Oobj->new();
+ my $cnt = 1;
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(0+$oo, 0+$ii, '0+ overload on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ is("$oo", "$ii", '0+ overload with stringification on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(0-$oo, 0-$ii, '0+ overload with subtraction on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is(2*$oo, 2*$ii, '0+ overload with multiplication on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo/1, $ii/1, '0+ overload with division on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo%100, $ii%100, '0+ overload with modulo on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ TODO: {
+ local $TODO = '64-bit int overloading produces floating-point';
+ is($oo**1, $ii**1, '0+ overload with exponentiation on 64-bit int');
+ }
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo>>3, $ii>>3, '0+ overload with bit shift right on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo<<2, $ii<<2, '0+ overload with bit shift left on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ ok($oo == $ii, '0+ overload with equality on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(int($oo), $ii, '0+ overload with int() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(+$oo, $ii, '0+ overload with unary + on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(-$oo, -$ii, '0+ overload with unary - on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+
+ ### Tests with large negative int
+ package Oobj2;
+ use overload '0+' => sub { ${$_[0]} += 1; -$ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj2') }
+
+ package main;
+ $oo = Oobj2->new();
+ $cnt = 1;
+
+ is(int($oo), -$ii, '0+ overload with int() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(+$oo, -$ii, '0+ overload with unary + on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+ is(-$oo, $ii, '0+ overload with unary - on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+
+ ### Tests with 'abs' overloading
+ package Oobj3;
+ use overload 'abs' => sub { ${$_[0]} += 1; $ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj3') }
+
+ package main;
+ $oo = Oobj3->new();
+ $cnt = 1;
+
+ is(abs($oo), $ii, '0+ overload with abs() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+
+
+ ### Tests with 'neg' overloading
+ package Oobj4;
+ use overload 'neg' => sub { ${$_[0]} += 1; -$ii },
+ 'fallback' => 1;
+ sub new { bless(\do{my $x = 0}, 'Oobj4') }
+
+ package main;
+ $oo = Oobj4->new();
+ $cnt = 1;
+
+ is(-$oo, -$ii, '0+ overload with neg() on 64-bit int');
+ is($$oo, $cnt++, 'overload called once');
+}
+
+# EOF
|
From @jdheddenI'm really on a roll here. I think I know how to fix all of this
|
From rick@bort.caOn Oct 08 2007, Jerry D. Hedden wrote:
Thanks for taking this on. I was going to do it but I'm pretty slow Please refactor the common stuff into a macro or function, though. And P.S. I think PTR2IV should be PTR2UV for the reference case. -- |
From @TuxOn Mon, 8 Oct 2007 10:18:05 -0400, Rick Delaney <rick@bort.ca> wrote:
I don't think Configure allows that currently on the current supported systems -- |
Migrated from rt.perl.org#46011 (status was 'resolved')
Searchable as RT46011$
The text was updated successfully, but these errors were encountered: