1 files changed, 69 insertions, 0 deletions
diff --git a/contrib/perl5/ext/Thread/sync2.t b/contrib/perl5/ext/Thread/sync2.t
new file mode 100644
index 0000000..0901da4
--- /dev/null
+++ b/contrib/perl5/ext/Thread/sync2.t
@@ -0,0 +1,69 @@
+use Thread;
+
+$global = undef;
+
+sub single_file {
+    use attrs 'locked';
+    my $who = shift;
+    my $i;
+
+    print "Uh oh: $who entered while locked by $global\n" if $global;
+    $global = $who;
+    print "[";
+    for ($i = 0; $i < int(10 * rand); $i++) {
+	print $who;
+	select(undef, undef, undef, 0.1);
+    }
+    print "]";
+    $global = undef;
+}
+
+sub start_a {
+    my ($i, $j);
+    for ($j = 0; $j < 10; $j++) {
+	single_file("A");
+	for ($i = 0; $i < int(10 * rand); $i++) {
+	    print "a";
+	    select(undef, undef, undef, 0.1);
+	}
+    }
+}
+
+sub start_b {
+    my ($i, $j);
+    for ($j = 0; $j < 10; $j++) {
+	single_file("B");
+	for ($i = 0; $i < int(10 * rand); $i++) {
+	    print "b";
+	    select(undef, undef, undef, 0.1);
+	}
+    }
+}
+
+sub start_c {
+    my ($i, $j);
+    for ($j = 0; $j < 10; $j++) {
+	single_file("C");
+	for ($i = 0; $i < int(10 * rand); $i++) {
+	    print "c";
+	    select(undef, undef, undef, 0.1);
+	}
+    }
+}
+
+$| = 1;
+srand($$^$^T);
+
+print <<'EOT';
+Each pair of square brackets [...] should contain a repeated sequence of
+a unique upper case letter. Lower case letters may appear randomly both
+in and out of the brackets.
+EOT
+$foo = new Thread \&start_a;
+$bar = new Thread \&start_b;
+$baz = new Thread \&start_c;
+print "\nmain: joining...\n";
+#$foo->join;
+#$bar->join;
+#$baz->join;
+print "\ndone\n";