test ( $b eq "88"); # 30
test (ref $a eq "Oscalar"); # 31
+undef $b; # Destroying updates tables too...
eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
sub STORE {
my $obj = shift;
$#$obj = 1;
- @$obj->[0,1] = ('=', shift);
+ $obj->[1] = shift;
}
}
sub STORE {
my $obj = shift;
$#$obj = 1;
- @$obj->[0,1] = ('=', shift);
+ $obj->[1] = shift;
}
}
{
# check the Odd number of arguments for overload::constant warning
my $a = "" ;
- local $SIG{__WARN__} = sub {$a = @_[0]} ;
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
$x = eval ' overload::constant "integer" ; ' ;
test($a eq "") ; # 210
use warnings 'overload' ;
{
# check the `$_[0]' is not an overloadable type warning
my $a = "" ;
- local $SIG{__WARN__} = sub {$a = @_[0]} ;
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
$x = eval ' overload::constant "fred" => sub {} ; ' ;
test($a eq "") ; # 212
use warnings 'overload' ;
{
# check the `$_[1]' is not a code reference warning
my $a = "" ;
- local $SIG{__WARN__} = sub {$a = @_[0]} ;
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
$x = eval ' overload::constant "integer" => 1; ' ;
test($a eq "") ; # 214
use warnings 'overload' ;
test($a =~ /^`1' is not a code reference at/); # 215
}
+{
+ my $c = 0;
+ package ov_int1;
+ use overload '""' => sub { 3+shift->[0] },
+ '0+' => sub { 10+shift->[0] },
+ 'int' => sub { 100+shift->[0] };
+ sub new {my $p = shift; bless [shift], $p}
+
+ package ov_int2;
+ use overload '""' => sub { 5+shift->[0] },
+ '0+' => sub { 30+shift->[0] },
+ 'int' => sub { 'ov_int1'->new(1000+shift->[0]) };
+ sub new {my $p = shift; bless [shift], $p}
+
+ package noov_int;
+ use overload '""' => sub { 2+shift->[0] },
+ '0+' => sub { 9+shift->[0] };
+ sub new {my $p = shift; bless [shift], $p}
+
+ package main;
+
+ my $x = new noov_int 11;
+ my $int_x = int $x;
+ main::test("$int_x" eq 20); # 216
+ $x = new ov_int1 31;
+ $int_x = int $x;
+ main::test("$int_x" eq 131); # 217
+ $x = new ov_int2 51;
+ $int_x = int $x;
+ main::test("$int_x" eq 1054); # 218
+}
+
# make sure that we don't inifinitely recurse
{
my $c = 0;
'bool' => sub { shift },
fallback => 1;
my $x = bless([]);
- main::test("$x" =~ /Recurse=ARRAY/); # 216
- main::test($x); # 217
- main::test($x+0 =~ /Recurse=ARRAY/); # 218
-};
+ main::test("$x" =~ /Recurse=ARRAY/); # 219
+ main::test($x); # 220
+ main::test($x+0 =~ /Recurse=ARRAY/); # 221
+}
+
+# BugID 20010422.003
+package Foo;
+
+use overload
+ 'bool' => sub { return !$_[0]->is_zero() || undef; }
+;
+
+sub is_zero
+ {
+ my $self = shift;
+ return $self->{var} == 0;
+ }
+
+sub new
+ {
+ my $class = shift;
+ my $self = {};
+ $self->{var} = shift;
+ bless $self,$class;
+ }
+
+package main;
+
+use strict;
+
+my $r = Foo->new(8);
+$r = Foo->new(0);
+
+test(($r || 0) == 0); # 222
# Last test is:
-sub last {218}
+sub last {222}