X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Foverload.t;h=1f9bc1ba2f0ff48cbdf34d00c2c0d56c31d188df;hb=d00e3d8a4128dcffa1eb58ae423543a07d0589f8;hp=94cd296b443f4658bf2b41733bddaf685f80695d;hpb=800401ee2a8a5a67ef478227b68426cf701d0116;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/overload.t b/lib/overload.t index 94cd296..1f9bc1b 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead package main; $| = 1; -use Test::More tests => 556; +use Test::More tests => 577; $a = new Oscalar "087"; @@ -361,6 +361,13 @@ is(($aII << 3), '_<<_087_<<_'); } is($int, 9); is($out, 1024); +is($int, 9); +{ + BEGIN { overload::constant 'integer' => sub {$int++; shift()+1}; } + eval q{$out = 42}; +} +is($int, 10); +is($out, 43); $foo = 'foo'; $foo1 = 'f\'o\\o'; @@ -1125,7 +1132,7 @@ like ($@, qr/zap/); like(overload::StrVal(sub{1}), qr/^CODE\(0x[0-9a-f]+\)$/); like(overload::StrVal(\*GLOB), qr/^GLOB\(0x[0-9a-f]+\)$/); like(overload::StrVal(\$o), qr/^REF\(0x[0-9a-f]+\)$/); - like(overload::StrVal(qr/a/), qr/^Regexp=SCALAR\(0x[0-9a-f]+\)$/); + like(overload::StrVal(qr/a/), qr/^Regexp=REGEXP\(0x[0-9a-f]+\)$/); like(overload::StrVal($o), qr/^perl31793=ARRAY\(0x[0-9a-f]+\)$/); like(overload::StrVal($of), qr/^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/); like(overload::StrVal($no), qr/^no_overload=ARRAY\(0x[0-9a-f]+\)$/); @@ -1225,6 +1232,46 @@ foreach my $op (qw(<=> == != < <= > >=)) { ok(!$b, "Expect overloaded boolean"); ok(!$a, "Expect overloaded boolean"); } + +{ + package Flrbbbbb; + use overload + bool => sub { shift->{truth} eq 'yes' }, + '0+' => sub { shift->{truth} eq 'yes' ? '1' : '0' }, + '!' => sub { shift->{truth} eq 'no' }, + fallback => 1; + + sub new { my $class = shift; bless { truth => shift }, $class } + + package main; + + my $yes = Flrbbbbb->new('yes'); + my $x; + $x = 1 if $yes; is($x, 1); + $x = 2 unless $yes; is($x, 1); + $x = 3 if !$yes; is($x, 1); + $x = 4 unless !$yes; is($x, 4); + + my $no = Flrbbbbb->new('no'); + $x = 0; + $x = 1 if $no; is($x, 0); + $x = 2 unless $no; is($x, 2); + $x = 3 if !$no; is($x, 3); + $x = 4 unless !$no; is($x, 3); + + $x = 0; + $x = 1 if !$no && $yes; is($x, 1); + $x = 2 unless !$no && $yes; is($x, 1); + $x = 3 if $no || !$yes; is($x, 1); + $x = 4 unless $no || !$yes; is($x, 4); + + $x = 0; + $x = 1 if !$no || !$yes; is($x, 1); + $x = 2 unless !$no || !$yes; is($x, 1); + $x = 3 if !$no && !$yes; is($x, 1); + $x = 4 unless !$no && !$yes; is($x, 4); +} + { use Scalar::Util 'weaken'; @@ -1427,4 +1474,20 @@ foreach my $op (qw(<=> == != < <= > >=)) { is($aref**1, $num_val, 'exponentiation of ref'); } +{ + package CopyConstructorFallback; + use overload + '++' => sub { "$_[0]"; $_[0] }, + fallback => 1; + sub new { bless {} => shift } + + package main; + + my $o = CopyConstructorFallback->new; + my $x = $o++; # would segfault + my $y = ++$o; + is($x, $o, "copy constructor falls back to assignment (postinc)"); + is($y, $o, "copy constructor falls back to assignment (preinc)"); +} + # EOF