1*5759b3d2Safresh1#!perl -w 2*5759b3d2Safresh1use Test2::Util qw/CAN_THREAD/; 3*5759b3d2Safresh1 4*5759b3d2Safresh1BEGIN { 5*5759b3d2Safresh1 if( $ENV{PERL_CORE} ) { 6*5759b3d2Safresh1 chdir 't'; 7*5759b3d2Safresh1 @INC = ('../lib', 'lib'); 8*5759b3d2Safresh1 } 9*5759b3d2Safresh1 else { 10*5759b3d2Safresh1 unshift @INC, 't/lib'; 11*5759b3d2Safresh1 } 12*5759b3d2Safresh1} 13*5759b3d2Safresh1chdir 't'; 14*5759b3d2Safresh1 15*5759b3d2Safresh1BEGIN { 16*5759b3d2Safresh1 # There was a bug with overloaded objects and threads. 17*5759b3d2Safresh1 # See rt.cpan.org 4218 18*5759b3d2Safresh1 eval { require threads; 'threads'->import; 1; } if CAN_THREAD; 19*5759b3d2Safresh1} 20*5759b3d2Safresh1 21*5759b3d2Safresh1use Test::More; 22*5759b3d2Safresh1 23*5759b3d2Safresh1plan skip_all => "known to crash on $]" if $] le "5.006002"; 24*5759b3d2Safresh1 25*5759b3d2Safresh1plan tests => 5; 26*5759b3d2Safresh1 27*5759b3d2Safresh1 28*5759b3d2Safresh1package Overloaded; 29*5759b3d2Safresh1 30*5759b3d2Safresh1use overload 31*5759b3d2Safresh1 q{""} => sub { $_[0]->{string} }; 32*5759b3d2Safresh1 33*5759b3d2Safresh1sub new { 34*5759b3d2Safresh1 my $class = shift; 35*5759b3d2Safresh1 bless { string => shift }, $class; 36*5759b3d2Safresh1} 37*5759b3d2Safresh1 38*5759b3d2Safresh1 39*5759b3d2Safresh1package main; 40*5759b3d2Safresh1 41*5759b3d2Safresh1my $warnings = ''; 42*5759b3d2Safresh1local $SIG{__WARN__} = sub { $warnings = join '', @_ }; 43*5759b3d2Safresh1 44*5759b3d2Safresh1# overloaded object as name 45*5759b3d2Safresh1my $obj = Overloaded->new('foo'); 46*5759b3d2Safresh1ok( 1, $obj ); 47*5759b3d2Safresh1 48*5759b3d2Safresh1# overloaded object which returns undef as name 49*5759b3d2Safresh1my $undef = Overloaded->new(undef); 50*5759b3d2Safresh1pass( $undef ); 51*5759b3d2Safresh1 52*5759b3d2Safresh1is( $warnings, '' ); 53*5759b3d2Safresh1 54*5759b3d2Safresh1 55*5759b3d2Safresh1TODO: { 56*5759b3d2Safresh1 my $obj = Overloaded->new('not really todo, testing overloaded reason'); 57*5759b3d2Safresh1 local $TODO = $obj; 58*5759b3d2Safresh1 fail("Just checking todo as an overloaded value"); 59*5759b3d2Safresh1} 60*5759b3d2Safresh1 61*5759b3d2Safresh1 62*5759b3d2Safresh1SKIP: { 63*5759b3d2Safresh1 my $obj = Overloaded->new('not really skipped, testing overloaded reason'); 64*5759b3d2Safresh1 skip $obj, 1; 65*5759b3d2Safresh1} 66