From: Vincent Pit Date: Tue, 1 Jun 2010 16:08:12 +0000 (+0200) Subject: Add a basic thread safety test in t/50-threads.t X-Git-Tag: rt62800~16 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=120d12f635bf0ef0f334f463c455a0d2082db4e9;p=perl%2Fmodules%2Fautovivification.git Add a basic thread safety test in t/50-threads.t --- diff --git a/MANIFEST b/MANIFEST index 0658bcd..28df70a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -18,6 +18,7 @@ t/33-array-tied.t t/40-scope.t t/41-padsv.t t/42-deparse.t +t/50-threads.t t/51-threads-teardown.t t/91-pod.t t/92-pod-coverage.t diff --git a/t/50-threads.t b/t/50-threads.t new file mode 100644 index 0000000..99aa1ad --- /dev/null +++ b/t/50-threads.t @@ -0,0 +1,81 @@ +#!perl -T + +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 { + require autovivification; + if (autovivification::A_THREADSAFE()) { + plan tests => 10 * 2 * 3 * (1 + 2); + defined and diag "Using threads $_" for $threads::VERSION; + } else { + plan skip_all => 'This autovivification isn\'t thread safe'; + } +} + +{ + no autovivification; + + sub try { + my $tid = threads->tid(); + + for my $run (1 .. 2) { + { + my $x; + my $y = $x->{foo}; + is $x, undef, "fetch does not autovivify at thread $tid run $run"; + } + { + my $x; + my $y = exists $x->{foo}; + is $x, undef, "exists does not autovivify at thread $tid run $run"; + } + { + my $x; + my $y = delete $x->{foo}; + is $x, undef, "delete does not autovivify at thread $tid run $run"; + } + +SKIP: + { + skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 * 2 + unless $] >= 5.010; + { + my $x; + eval 'my $y = $x->{foo}'; + is $@, '', "fetch in eval does not croak at thread $tid run $run"; + is $x, undef, "fetch in eval does not autovivify at thread $tid run $run"; + } + { + my $x; + eval 'my $y = exists $x->{foo}'; + is $@, '', "exists in eval does not croak at thread $tid run $run"; + is $x, undef, "exists in eval does not autovivify at thread $tid run $run"; + } + { + my $x; + eval 'my $y = delete $x->{foo}'; + is $@, '', "delete in eval does not croak at thread $tid run $run"; + is $x, undef, "delete in eval does not autovivify at thread $tid run $run"; + } + } + } + } +} + +my @t = map threads->create(\&try), 1 .. 10; +$_->join for @t;