#!perl use strict; use warnings; use Config qw/%Config/; BEGIN { if (!$Config{useithreads}) { require Test::More; Test::More->import; plan(skip_all => 'This perl wasn\'t built to support threads'); } } use threads; use Test::More; BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE}; require indirect; if (indirect::I_THREADSAFE()) { plan tests => 1; defined and diag "Using threads $_" for $threads::VERSION; } else { plan skip_all => 'This indirect isn\'t thread safe'; } } sub run_perl { my $code = shift; my $SystemRoot = $ENV{SystemRoot}; local %ENV; $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot; system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code; } SKIP: { skip 'Fails on 5.8.2 and lower' => 1 if $] <= 5.008002; my $status = run_perl <<' RUN'; my ($code, @expected); BEGIN { $code = 2; @expected = qw/X Z/; } sub cb { --$code if $_[0] eq shift(@expected) || q{DUMMY} } use threads; $code = threads->create(sub { eval q{return; no indirect hook => \&cb; new X;}; return $code; })->join; eval q{new Y;}; eval q{return; no indirect hook => \&cb; new Z;}; exit $code; RUN is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault'; }