6 unless ($Config{useithreads}) {
7 print "1..0 # SKIP your perl does not support ithreads\n";
13 unless (eval { require threads }) {
14 print "1..0 # SKIP threads.pm not installed\n";
20 if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
22 no warnings 'redefine';
24 for my $f (qw(DynaLoader::bootstrap XSLoader::load)) {
25 my ($mod) = $f =~ /^ (.+) \:\: [^:]+ $/x;
26 eval "require $mod" or die $@;
30 die 'no XS' if ($_[0]||'') eq 'Devel::GlobalDestruction';
38 package Test::Scope::Guard;
39 sub new { my ($class, $code) = @_; bless [$code], $class; }
40 sub DESTROY { my $self = shift; $self->[0]->() }
43 package Test::Thread::Clone;
45 sub new { my ($class, $code) = @_; push @code, $code; bless [$code], $class; }
46 sub CLONE { $_->() for @code }
54 our $had_error :shared;
55 END { $? = $had_error||0 }
58 $had_error++, print "not " if !$_[0];
60 print " - $_[1]" if defined $_[1];
64 # load it before spawning a thread, that's the whole point
65 use Devel::GlobalDestruction;
67 our $cloner = Test::Thread::Clone->new(sub {
68 ok( ! in_global_destruction(), "CLONE is not GD" );
69 my $guard = Test::Scope::Guard->new(sub {
70 ok( ! in_global_destruction(), "DESTROY during CLONE is not GD");
73 our $global = Test::Scope::Guard->new(sub {
74 ok( in_global_destruction(), "Final cleanup object destruction properly in GD in " . (threads->tid ? 'thread' : 'main program') );
78 # just die so we don't need to deal with testcount skew
79 unless ( ($_[0]||'') eq 'arg' ) {
81 die "Argument passing failed!";
83 # nothing really to do in here
87 threads->create('do_test', 'arg')->join