X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Foverload.t;h=6dafa07576f78ec0c11c29401af6ae18f2bd6da1;hb=81a4c762684cf629f6e7986fe1827ecd2af35ba2;hp=78548605f3b404ddcf7717c48cbda77eab826a0c;hpb=b1fbf5c3d1dc6dd7934002da04dede2ae2e3ef65;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/overload.t b/lib/overload.t
index 7854860..6dafa07 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=>497;
+use Test::More tests => 509;
 
 
 $a = new Oscalar "087";
@@ -1180,3 +1180,76 @@ foreach my $op (qw(<=> == != < <= > >=)) {
     BEGIN { overload::constant integer => sub { 23 } }
     is(eval "17", $twenty_three);
 }
+
+{
+    package Sklorsh;
+    use overload
+	bool     => sub { shift->is_cool };
+
+    sub is_cool {
+	$_[0]->{name} eq 'cool';
+    }
+
+    sub delete {
+	undef %{$_[0]};
+	bless $_[0], 'Brap';
+	return 1;
+    }
+
+    sub delete_with_self {
+	my $self = shift;
+	undef %$self;
+	bless $self, 'Brap';
+	return 1;
+    }
+
+    package Brap;
+
+    1;
+
+    package main;
+
+    my $obj;
+    $obj = bless {name => 'cool'}, 'Sklorsh';
+    $obj->delete;
+    ok(eval {if ($obj) {1}; 1}, $@ || 'reblessed into nonexist namespace');
+
+    $obj = bless {name => 'cool'}, 'Sklorsh';
+    $obj->delete_with_self;
+    ok (eval {if ($obj) {1}; 1}, $@);
+    
+    my $a = $b = {name => 'hot'};
+    bless $b, 'Sklorsh';
+    is(ref $a, 'Sklorsh');
+    is(ref $b, 'Sklorsh');
+    ok(!$b, "Expect overloaded boolean");
+    ok(!$a, "Expect overloaded boolean");
+}
+{
+    use Scalar::Util 'weaken';
+
+    package Shklitza;
+    use overload '""' => sub {"CLiK KLAK"};
+
+    package Ksshfwoom;
+
+    package main;
+
+    my ($obj, $ref);
+    $obj = bless do {my $a; \$a}, 'Shklitza';
+    $ref = $obj;
+
+    is ($obj, "CLiK KLAK");
+    is ($ref, "CLiK KLAK");
+
+    weaken $ref;
+    is ($ref, "CLiK KLAK");
+
+    bless $obj, 'Ksshfwoom';
+
+    like ($obj, qr/^Ksshfwoom=/);
+    like ($ref, qr/^Ksshfwoom=/);
+
+    undef $obj;
+    is ($ref, undef);
+}