Integrate mainline

[p5sagit/p5-mst-13.2.git] / t / pragma / overload.t

diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index c7105dc..d075062 100755 (executable)
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -133,6 +133,7 @@ test ( $a eq "087");                # 29
 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] } ) ];
 
@@ -493,7 +494,7 @@ test($c, "bareword");       # 135
   sub STORE { 
     my $obj = shift; 
     $#$obj = 1; 
-    @$obj->[0,1] = ('=', shift);
+    $obj->[1] = shift;
   }
 }
 
@@ -614,7 +615,7 @@ test($c, "bareword");       # 135
   sub STORE { 
     my $obj = shift; 
     $#$obj = 1; 
-    @$obj->[0,1] = ('=', shift);
+    $obj->[1] = shift;
   }
 }
 
@@ -969,6 +970,38 @@ unless ($aaa) {
     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;
@@ -978,10 +1011,40 @@ unless ($aaa) {
                '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}