Commit | Line | Data |
7483b81c |
1 | #!perl -w |
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 | } |
12 | chdir 't'; |
13 | |
14 | BEGIN { |
15 | # There was a bug with overloaded objects and threads. |
16 | # See rt.cpan.org 4218 |
17 | eval { require threads; 'threads'->import; 1; }; |
18 | } |
19 | |
20 | use Test::More; |
21 | |
22 | BEGIN { |
23 | if( !eval "require overload" ) { |
24 | plan skip_all => "needs overload.pm"; |
25 | } |
26 | else { |
27 | plan tests => 5; |
28 | } |
29 | } |
30 | |
31 | |
32 | package Overloaded; |
33 | |
34 | use overload |
35 | q{""} => sub { $_[0]->{string} }; |
36 | |
37 | sub new { |
38 | my $class = shift; |
39 | bless { string => shift }, $class; |
40 | } |
41 | |
42 | |
43 | package main; |
44 | |
45 | my $warnings = ''; |
46 | local $SIG{__WARN__} = sub { $warnings = join '', @_ }; |
47 | |
48 | # overloaded object as name |
49 | my $obj = Overloaded->new('foo'); |
50 | ok( 1, $obj ); |
51 | |
52 | # overloaded object which returns undef as name |
53 | my $undef = Overloaded->new(undef); |
54 | pass( $undef ); |
55 | |
56 | is( $warnings, '' ); |
57 | |
58 | |
59 | TODO: { |
60 | my $obj = Overloaded->new('not really todo, testing overloaded reason'); |
61 | local $TODO = $obj; |
62 | fail("Just checking todo as an overloaded value"); |
63 | } |
64 | |
65 | |
66 | SKIP: { |
67 | my $obj = Overloaded->new('not really skipped, testing overloaded reason'); |
68 | skip $obj, 1; |
69 | } |