From: Stas Bekman <stas@stason.org>
Date: Tue, 23 Dec 2003 15:32:26 +0000 (-0800)
Subject: Add a new test file for situations where threads may interfere.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f935b2f67f1c88a353de5d1c0f7792d9812d8f31;p=p5sagit%2Fp5-mst-13.2.git

Add a new test file for situations where threads may interfere.
Subject: Re: "restricted hashes" hit again !
Message-ID: <3FE8D08A.4090806@stason.org>

p4raw-id: //depot/perl@22186
---

diff --git a/MANIFEST b/MANIFEST
index 4086e15..f59a1f1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2856,6 +2856,7 @@ t/op/subst_wamp.t		See if substitution works with $& present
 t/op/sub.t			See if subroutines work
 t/op/sysio.t			See if sysread and syswrite work
 t/op/taint.t			See if tainting works
+t/op/threads.t			Misc. tests for perl features with threads
 t/op/tiearray.t			See if tie for arrays works
 t/op/tiehandle.t		See if tie for handles works
 t/op/tie.t			See if tie/untie functions work
diff --git a/t/op/threads.t b/t/op/threads.t
new file mode 100644
index 0000000..02ae213
--- /dev/null
+++ b/t/op/threads.t
@@ -0,0 +1,61 @@
+#!./perl
+BEGIN {
+     chdir 't' if -d 't';
+     unshift @INC, '../lib';
+     require './test.pl';	# for which_perl() etc
+}
+
+use strict;
+use Config;
+
+BEGIN {
+     if (!$Config{useithreads}) {
+	print "1..0 # Skip: no ithreads\n";
+	exit 0;
+     }
+     eval 'use threads';
+     if ($@ =~ /dynamic loading not available/) {
+	print "1..0 # Skip: miniperl can't load threads\n";
+	exit 0;
+     }
+     plan(3);
+}
+
+# test that we don't get:
+# Attempt to free unreferenced scalar: SV 0x40173f3c
+fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
+use threads;
+threads->new(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
+print "ok";
+EOI
+
+#PR24660
+# test that we don't get:
+# Attempt to free unreferenced scalar: SV 0x814e0dc.
+fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
+use threads;
+use Scalar::Util;
+my $data = "a";
+my $obj = \$data;
+my $copy = $obj;
+Scalar::Util::weaken($copy);
+threads->new(sub { 1 })->join for (1..1);
+print "ok";
+EOI
+
+#PR24663
+# test that we don't get:
+# panic: magic_killbackrefs.
+# Scalars leaked: 3
+fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
+package Foo;
+sub new { bless {},shift }
+package main;
+use threads;
+use Scalar::Util qw(weaken);
+my $object = Foo->new;
+my $ref = $object;
+weaken $ref;
+threads->new(sub { $ref = $object } )->join; # $ref = $object causes problems
+print "ok";
+EOI