From: Ricardo SIGNES <rjbs@cpan.org>
Date: Fri, 18 Apr 2008 18:02:38 +0000 (-0400)
Subject: New tests (and TODO tests) for ~~ and overloading,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a26136ef4f31e2fb1d3630b5c3f021c56c89644b;p=p5sagit%2Fp5-mst-13.2.git

New tests (and TODO tests) for ~~ and overloading,
based on:

Subject: object ~~ overloading and not
Message-ID: <20080418220238.GA91526@knight.local>

p4raw-id: //depot/perl@33750
---

diff --git a/MANIFEST b/MANIFEST
index da2b9ac..414dac6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3970,6 +3970,7 @@ t/op/runlevel.t			See if die() works from perl_call_*()
 t/op/rxcode.t			See if /(?{ code })/ works
 t/op/sleep.t			See if sleep works
 t/op/smartmatch.t		See if the ~~ operator works
+t/op/smobj.t			See how the ~~ operator works with overloading
 t/op/sort.t			See if sort works
 t/op/splice.t			See if splice works
 t/op/split.t			See if split works
diff --git a/t/op/smobj.t b/t/op/smobj.t
new file mode 100644
index 0000000..733e31c
--- /dev/null
+++ b/t/op/smobj.t
@@ -0,0 +1,48 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 5;
+
+use strict;
+use warnings;
+
+{
+    package Test::Object::NoOverload;
+    sub new { bless { key => 1 } }
+}
+
+{
+    my $obj = Test::Object::NoOverload->new;
+    isa_ok($obj, 'Test::Object::NoOverload');
+    my $r = eval { ($obj ~~ 'key') };
+
+    local $::TODO = 'To be implemented';
+
+    ok(
+	! defined $r,
+	"we do not smart match against an object's underlying implementation",
+    );
+
+    like(
+	$@,
+	qr/overload/,
+	"we die when smart matching an obj with no ~~ overload",
+    );
+}
+
+{
+    package Test::Object::CopyOverload;
+    sub new { bless { key => 1 } }
+    use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[1] };
+}
+
+{
+    my $obj = Test::Object::CopyOverload->new;
+    isa_ok($obj, 'Test::Object::CopyOverload');
+    ok($obj ~~ 'key', 'we are able to make an object ~~ overload');
+}