X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F51-threads-teardown.t;h=4ff53452e15023ebd1e94bf8a9b14b06b4463deb;hb=e2cf50a4ad234e0ab9844ac0cb45f2a363abe217;hp=d825f91bb5c2689e852af1a40211b192af4b3f0d;hpb=624f3e979a9d31ae5d86d95fa008af05fa83723e;p=perl%2Fmodules%2Fautovivification.git diff --git a/t/51-threads-teardown.t b/t/51-threads-teardown.t index d825f91..4ff5345 100644 --- a/t/51-threads-teardown.t +++ b/t/51-threads-teardown.t @@ -3,47 +3,17 @@ use strict; use warnings; -sub skipall { - my ($msg) = @_; - require Test::More; - Test::More::plan(skip_all => $msg); -} - -use Config qw/%Config/; - -BEGIN { - my $force = $ENV{PERL_AUTOVIVIFICATION_TEST_THREADS} ? 1 : !1; - skipall 'This perl wasn\'t built to support threads' - unless $Config{useithreads}; - skipall 'perl 5.13.4 required to test thread safety' - unless $force or $] >= 5.013004; -} - -use threads; - -use Test::More; - -BEGIN { - require autovivification; - skipall 'This autovivification isn\'t thread safe' - unless autovivification::A_THREADSAFE(); - plan tests => 1; - defined and diag "Using threads $_" for $threads::VERSION; -} - -sub run_perl { - my $code = shift; +use lib 't/lib'; +use VPIT::TestHelpers ( + threads => [ 'autovivification' => 'autovivification::A_THREADSAFE()' ], + 'run_perl', +); - 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; -} +use Test::Leaner tests => 2; SKIP: { - skip 'Fails on 5.8.2 and lower' => 1 if $] <= 5.008002; + skip 'Fails on 5.8.2 and lower' => 1 if "$]" <= 5.008_002; my $status = run_perl <<' RUN'; my $code = 1 + 2 + 4; @@ -57,5 +27,26 @@ SKIP: ? 0 : 4; exit $code; RUN - is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault'; + skip RUN_PERL_FAILED() => 1 unless defined $status; + is $status, 0, + 'loading the pragma in a thread and using it outside doesn\'t segfault'; +} + +SKIP: { + my $status = run_perl <<' RUN'; + use threads; + BEGIN { require autovivification; } + sub X::DESTROY { + eval 'no autovivification; my $x; my $y = $x->{foo}{bar}; use autovivification; my $z = $x->{a}{b}{c};'; + exit 1 if $@; + } + threads->create(sub { + my $x = bless { }, 'X'; + $x->{self} = $x; + return; + })->join; + exit $code; + RUN + skip RUN_PERL_FAILED() => 1 unless defined $status; + is $status, 0, 'autovivification can be loaded in eval STRING during global destruction at the end of a thread'; }