vcs.maemo.org Git - pkg-perl/blob - deb-src/libtest-simple-perl/libtest-simple-perl-0.80/t/overload_threads.t

   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 }