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

1 files changed, 61 insertions, 0 deletions

diff --git a/t/op/threads.t b/t/op/threads.t
new file mode 100644
index 0000000000..02ae213b34
--- /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