From: Vincent Pit <vince@profvince.com>
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;