Commit | Line | Data |
a26136ef |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | } |
8 | |
e67b97bd |
9 | plan tests => 11; |
a26136ef |
10 | |
11 | use strict; |
12 | use warnings; |
13 | |
e67b97bd |
14 | |
15 | my @tests = ('$obj ~~ "key"', '"key" ~~ $obj', '$obj ~~ $obj'); |
16 | |
a26136ef |
17 | { |
18 | package Test::Object::NoOverload; |
19 | sub new { bless { key => 1 } } |
20 | } |
21 | |
22 | { |
23 | my $obj = Test::Object::NoOverload->new; |
24 | isa_ok($obj, 'Test::Object::NoOverload'); |
e67b97bd |
25 | for (@tests) { |
26 | my $r = eval; |
27 | ok( |
28 | ! defined $r, |
29 | "we do not smart match against an object's underlying implementation", |
30 | ); |
31 | like( |
32 | $@, |
33 | qr/overload/, |
34 | "we die when smart matching an obj with no ~~ overload", |
35 | ); |
36 | } |
a26136ef |
37 | } |
38 | |
39 | { |
40 | package Test::Object::CopyOverload; |
41 | sub new { bless { key => 1 } } |
42 | use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[1] }; |
43 | } |
44 | |
45 | { |
46 | my $obj = Test::Object::CopyOverload->new; |
47 | isa_ok($obj, 'Test::Object::CopyOverload'); |
e67b97bd |
48 | ok(eval, 'we are able to make an object ~~ overload') for @tests; |
a26136ef |
49 | } |