lib/Test/Simple/t/overload_threads.t

   1 #!perl -w
   2 # $Id: /mirror/googlecode/test-more/t/overload_threads.t 57943 2008-08-18T02:09:22.275428Z brooklyn.kid51  $
   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 }