Commit | Line | Data |
7483b81c |
1 | #!/usr/bin/perl -w |
30e302f8 |
2 | |
3 | BEGIN { |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = ('../lib', 'lib'); |
7 | } |
8 | else { |
9 | unshift @INC, 't/lib'; |
10 | } |
11 | } |
30e302f8 |
12 | |
7483b81c |
13 | use strict; |
3e887aae |
14 | use Test::More tests => 19; |
30e302f8 |
15 | |
16 | |
17 | package Overloaded; |
18 | |
19 | use overload |
3e887aae |
20 | q{eq} => sub { $_[0]->{string} eq $_[1] }, |
21 | q{==} => sub { $_[0]->{num} == $_[1] }, |
22 | q{""} => sub { $_[0]->{stringify}++; $_[0]->{string} }, |
82d700dc |
23 | q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} } |
24 | ; |
30e302f8 |
25 | |
26 | sub new { |
27 | my $class = shift; |
82d700dc |
28 | bless { |
29 | string => shift, |
30 | num => shift, |
31 | stringify => 0, |
32 | numify => 0, |
33 | }, $class; |
30e302f8 |
34 | } |
35 | |
36 | |
37 | package main; |
38 | |
c00d8759 |
39 | local $SIG{__DIE__} = sub { |
40 | my($call_file, $call_line) = (caller)[1,2]; |
41 | fail("SIGDIE accidentally called"); |
42 | diag("From $call_file at $call_line"); |
43 | }; |
44 | |
7483b81c |
45 | my $obj = Overloaded->new('foo', 42); |
46 | isa_ok $obj, 'Overloaded'; |
30e302f8 |
47 | |
3e887aae |
48 | cmp_ok $obj, 'eq', 'foo', 'cmp_ok() eq'; |
49 | is $obj->{stringify}, 0, ' does not stringify'; |
50 | is $obj, 'foo', 'is() with string overloading'; |
51 | cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading'; |
52 | is $obj->{numify}, 0, ' does not numify'; |
30e302f8 |
53 | |
7483b81c |
54 | is_deeply [$obj], ['foo'], 'is_deeply with string overloading'; |
55 | ok eq_array([$obj], ['foo']), 'eq_array ...'; |
56 | ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...'; |
b1ddf169 |
57 | |
58 | # rt.cpan.org 13506 |
59 | is_deeply $obj, 'foo', 'is_deeply with string overloading at the top'; |
60 | |
61 | Test::More->builder->is_num($obj, 42); |
62 | Test::More->builder->is_eq ($obj, "foo"); |
63 | |
64 | |
65 | { |
66 | # rt.cpan.org 14675 |
67 | package TestPackage; |
68 | use overload q{""} => sub { ::fail("This should not be called") }; |
69 | |
70 | package Foo; |
71 | ::is_deeply(['TestPackage'], ['TestPackage']); |
72 | ::is_deeply({'TestPackage' => 'TestPackage'}, |
73 | {'TestPackage' => 'TestPackage'}); |
74 | ::is_deeply('TestPackage', 'TestPackage'); |
75 | } |
3e887aae |
76 | |
77 | |
78 | # Make sure 0 isn't a special case. [rt.cpan.org 41109] |
79 | { |
80 | my $obj = Overloaded->new('0', 42); |
81 | isa_ok $obj, 'Overloaded'; |
82 | |
83 | cmp_ok $obj, 'eq', '0', 'cmp_ok() eq'; |
84 | is $obj->{stringify}, 0, ' does not stringify'; |
85 | is $obj, '0', 'is() with string overloading'; |
86 | } |