xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/t/Legacy/overload_threads.t (revision 5759b3d249badf144a6240f7eec4dcf9df003e6b)
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