cpan/Test-Simple/t/Legacy/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 tests => 5;
  21
  22
  23 package Overloaded;
  24
  25 use overload
  26   q{""} => sub { $_[0]->{string} };
  27
  28 sub new {
  29     my $class = shift;
  30     bless { string => shift }, $class;
  31 }
  32
  33
  34 package main;
  35
  36 my $warnings = '';
  37 local $SIG{__WARN__} = sub { $warnings = join '', @_ };
  38
  39 # overloaded object as name
  40 my $obj = Overloaded->new('foo');
  41 ok( 1, $obj );
  42
  43 # overloaded object which returns undef as name
  44 my $undef = Overloaded->new(undef);
  45 pass( $undef );
  46
  47 is( $warnings, '' );
  48
  49
  50 TODO: {
  51     my $obj = Overloaded->new('not really todo, testing overloaded reason');
  52     local $TODO = $obj;
  53     fail("Just checking todo as an overloaded value");
  54 }
  55
  56
  57 SKIP: {
  58     my $obj = Overloaded->new('not really skipped, testing overloaded reason');
  59     skip $obj, 1;
  60 }