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 42e4006..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;
   }
 }
 
@@ -935,5 +936,115 @@ unless ($aaa) {
   main::test $x, '0pq1';               # 209
 };
 
+# Test module-specific warning
+{
+    # check the Odd number of arguments for overload::constant warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a eq "") ; # 210
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+}
+
+{
+    # check the `$_[0]' is not an overloadable type warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a eq "") ; # 212
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a =~ /^`fred' is not an overloadable type at/); # 213
+}
+
+{
+    # check the `$_[1]' is not a code reference warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a eq "") ; # 214
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    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;
+  package Recurse;
+  use overload '""'    => sub { shift },
+               '0+'    => sub { shift },
+               'bool'  => sub { shift },
+               fallback => 1;
+  my $x = bless([]);
+  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 {209}
+sub last {222}