Front page | perl.perl5.changes |
Postings from April 2008
Change 33750 by rgs@scipion on 2008/04/26 21:22:56
New tests (and TODO tests) for ~~ and overloading,
based on:
Subject: object ~~ overloading and not
From: Ricardo SIGNES <perl.p5p@rjbs.manxome.org>
Date: Fri, 18 Apr 2008 18:02:38 -0400
Message-ID: <20080418220238.GA91526@knight.local>
Affected files ...
... //depot/perl/MANIFEST#1698 edit
... //depot/perl/t/op/smobj.t#1 add
Differences ...
==== //depot/perl/MANIFEST#1698 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1697~33716~ 2008-04-21 00:44:27.000000000 -0700
+++ perl/MANIFEST 2008-04-26 14:22:56.000000000 -0700
@@ -3970,6 +3970,7 @@
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
==== //depot/perl/t/op/smobj.t#1 (text) ====
Index: perl/t/op/smobj.t
--- /dev/null 2008-03-18 12:45:05.529577733 -0700
+++ perl/t/op/smobj.t 2008-04-26 14:22:56.000000000 -0700
@@ -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');
+}
End of Patch.