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