#!./perl

BEGIN {

chdir 't' if -d 't';

@INC = '../lib';

require Config;

if ($Config::Config{'uvsize'} != 8) {

print "1..0 # Skip -- Perl configured with 32-bit ints\n";

exit 0;

}

}

$| = 1;

use Test::More 'tests' => 140;

my $ii = 36028797018963971; # 2^55 + 3

### Tests with numerifying large positive int

{ package Oobj;

use overload '0+' => sub { ${$_[0]} += 1; $ii },

'fallback' => 1;

}

my $oo = bless(\do{my $x = 0}, 'Oobj');

my $cnt = 1;

is("$oo", "$ii", '0+ overload with stringification');

is($$oo, $cnt++, 'overload called once');

is($oo>>3, $ii>>3, '0+ overload with bit shift right');

is($$oo, $cnt++, 'overload called once');

is($oo<<2, $ii<<2, '0+ overload with bit shift left');

is($$oo, $cnt++, 'overload called once');

is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or');

is($$oo, $cnt++, 'overload called once');

is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and');

is($$oo, $cnt++, 'overload called once');

ok($oo == $ii, '0+ overload with equality');

is($$oo, $cnt++, 'overload called once');

is(int($oo), $ii, '0+ overload with int()');

is($$oo, $cnt++, 'overload called once');

is(abs($oo), $ii, '0+ overload with abs()');

is($$oo, $cnt++, 'overload called once');

is(-$oo, -$ii, '0+ overload with unary minus');

is($$oo, $cnt++, 'overload called once');

is(0+$oo, $ii, '0+ overload with addition');

is($$oo, $cnt++, 'overload called once');

is($oo+0, $ii, '0+ overload with addition');

is($$oo, $cnt++, 'overload called once');

is($oo+$oo, 2*$ii, '0+ overload with addition');

$cnt++;

is($$oo, $cnt++, 'overload called once');

is(0-$oo, -$ii, '0+ overload with subtraction');

is($$oo, $cnt++, 'overload called once');

is($oo-99, $ii-99, '0+ overload with subtraction');

is($$oo, $cnt++, 'overload called once');

is(2*$oo, 2*$ii, '0+ overload with multiplication');

is($$oo, $cnt++, 'overload called once');

is($oo*3, 3*$ii, '0+ overload with multiplication');

is($$oo, $cnt++, 'overload called once');

is($oo/1, $ii, '0+ overload with division');

is($$oo, $cnt++, 'overload called once');

is($ii/$oo, 1, '0+ overload with division');

is($$oo, $cnt++, 'overload called once');

is($oo%100, $ii%100, '0+ overload with modulo');

is($$oo, $cnt++, 'overload called once');

is($ii%$oo, 0, '0+ overload with modulo');

is($$oo, $cnt++, 'overload called once');

is($oo**1, $ii, '0+ overload with exponentiation');

is($$oo, $cnt++, 'overload called once');

### Tests with numerifying large negative int

{ package Oobj2;

use overload '0+' => sub { ${$_[0]} += 1; -$ii },

'fallback' => 1;

}

$oo = bless(\do{my $x = 0}, 'Oobj2');

$cnt = 1;

is(int($oo), -$ii, '0+ overload with int()');

is($$oo, $cnt++, 'overload called once');

is(abs($oo), $ii, '0+ overload with abs()');

is($$oo, $cnt++, 'overload called once');

is(-$oo, $ii, '0+ overload with unary -');

is($$oo, $cnt++, 'overload called once');

is(0+$oo, -$ii, '0+ overload with addition');

is($$oo, $cnt++, 'overload called once');

is($oo+0, -$ii, '0+ overload with addition');

is($$oo, $cnt++, 'overload called once');

is($oo+$oo, -2*$ii, '0+ overload with addition');

$cnt++;

is($$oo, $cnt++, 'overload called once');

is(0-$oo, $ii, '0+ overload with subtraction');

is($$oo, $cnt++, 'overload called once');

is(2*$oo, -2*$ii, '0+ overload with multiplication');

is($$oo, $cnt++, 'overload called once');

is($oo*3, -3*$ii, '0+ overload with multiplication');

is($$oo, $cnt++, 'overload called once');

is($oo/1, -$ii, '0+ overload with division');

is($$oo, $cnt++, 'overload called once');

is($ii/$oo, -1, '0+ overload with division');

is($$oo, $cnt++, 'overload called once');

is($oo%100, (-$ii)%100, '0+ overload with modulo');

is($$oo, $cnt++, 'overload called once');

is($ii%$oo, 0, '0+ overload with modulo');

is($$oo, $cnt++, 'overload called once');

is($oo**1, -$ii, '0+ overload with exponentiation');

is($$oo, $cnt++, 'overload called once');

### Tests with overloading but no fallback

{ package Oobj3;

use overload

'int' => sub { ${$_[0]} += 1; $ii },

'abs' => sub { ${$_[0]} += 1; $ii },

'neg' => sub { ${$_[0]} += 1; -$ii },

'+' => sub {

${$_[0]} += 1;

my $res = (ref($_[0]) eq __PACKAGE__) ? $ii : $_[0];

$res += (ref($_[1]) eq __PACKAGE__) ? $ii : $_[1];

},

'-' => sub {

${$_[0]} += 1;

my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);

my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l];

$res -= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r];

},

'*' => sub {

${$_[0]} += 1;

my $res = (ref($_[0]) eq __PACKAGE__) ? $ii : $_[0];

$res *= (ref($_[1]) eq __PACKAGE__) ? $ii : $_[1];

},

'/' => sub {

${$_[0]} += 1;

my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);

my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii+1 : $_[$l];

$res /= (ref($_[$r]) eq __PACKAGE__) ? $ii+1 : $_[$r];

},

'%' => sub {

${$_[0]} += 1;

my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);

my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l];

$res %= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r];

},

'**' => sub {

${$_[0]} += 1;

my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);

my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l];

$res **= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r];

},

}

$oo = bless(\do{my $x = 0}, 'Oobj3');

$cnt = 1;

is(int($oo), $ii, 'int() overload');

is($$oo, $cnt++, 'overload called once');

is(abs($oo), $ii, 'abs() overload');

is($$oo, $cnt++, 'overload called once');

is(-$oo, -$ii, 'neg overload');

is($$oo, $cnt++, 'overload called once');

is(0+$oo, $ii, '+ overload');

is($$oo, $cnt++, 'overload called once');

is($oo+0, $ii, '+ overload');

is($$oo, $cnt++, 'overload called once');

is($oo+$oo, 2*$ii, '+ overload');

is($$oo, $cnt++, 'overload called once');

is(0-$oo, -$ii, '- overload');

is($$oo, $cnt++, 'overload called once');

is($oo-99, $ii-99, '- overload');

is($$oo, $cnt++, 'overload called once');

is($oo*2, 2*$ii, '* overload');

is($$oo, $cnt++, 'overload called once');

is(-3*$oo, -3*$ii, '* overload');

is($$oo, $cnt++, 'overload called once');

is($oo/2, ($ii+1)/2, '/ overload');

is($$oo, $cnt++, 'overload called once');

is(($ii+1)/$oo, 1, '/ overload');

is($$oo, $cnt++, 'overload called once');

is($oo%100, $ii%100, '% overload');

is($$oo, $cnt++, 'overload called once');

is($ii%$oo, 0, '% overload');

is($$oo, $cnt++, 'overload called once');

is($oo**1, $ii, '** overload');

is($$oo, $cnt++, 'overload called once');

# RT #77456: when conversion method returns an IV/UV,

# avoid IV -> NV upgrade if possible .

{

package P77456;

use overload '0+' => sub { $_[0][0] }, fallback => 1;

package main;

for my $expr (

'(%531 + 1) - $a531 == 1', # pp_add

'$a531 - (%531 - 1) == 1', # pp_subtract

'(%531 * 2 + 1) - (%531 * 2) == 1', # pp_multiply

'(%54 / 2 + 1) - (%54 / 2) == 1', # pp_divide

'(%271 ** 2 + 1) - (%271 ** 2) == 1', # pp_pow

'(%541 % 2) == 1', # pp_modulo

'$a54 + (-%531)*2 == -2', # pp_negate

'(abs(%53m)+1) - $a53 == 1', # pp_abs

'(%531 << 1) - 2 == $a54', # pp_left_shift

'(%541 >> 1) + 1 == $a531', # pp_right_shift

'!(%53 == %531)', # pp_eq

'(%53 != %531)', # pp_ne

'(%53 < %531)', # pp_lt

'!(%531 <= %53)', # pp_le

'(%531 > %53)', # pp_gt

'!(%53 >= %531)', # pp_ge

'(%53 <=> %531) == -1', # pp_ncmp

'(%531 & %53) == $a53', # pp_bit_and

'(%531 | %53) == $a531', # pp_bit_or

'~(~ %531 + $a531) == 0', # pp_complement

) {

for my $int ('', 'use integer; ') {

(my $aexpr = "$int$expr") =~ s/\%(\d+m?)/\$a$1/g;

(my $bexpr = "$int$expr") =~ s/\%(\d+m?)/\$b$1/g;

my $a27 = 1 << 27;

my $a271 = $a27 + 1;

my $a53 = 1 << 53;

my $a53m = -$a53;

my $a531 = $a53 + 1;

my $a54 = 1 << 54;

my $a541 = $a54 + 1;

my $b27 = bless [ $a27 ], 'P77456';

my $b271 = bless [ $a271 ], 'P77456';

my $b53 = bless [ $a53 ], 'P77456';

my $b53m = bless [ $a53m ], 'P77456';

my $b531 = bless [ $a531 ], 'P77456';

my $b54 = bless [ $a54 ], 'P77456';

my $b541 = bless [ $a541 ], 'P77456';

SKIP: {

skip("IV/NV not suitable on this platform: $aexpr", 1)

unless eval $aexpr;

ok(eval $bexpr, "IV: $bexpr");

}

}

}

}

# EOF