1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl'; # for which_perl() etc
$| = 1;
}
use strict;
use Config;
BEGIN {
if (!$Config{useithreads}) {
print "1..0 # Skip: no ithreads\n";
exit 0;
}
if ($ENV{PERL_CORE_MINITEST}) {
print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
exit 0;
}
plan(6);
}
use threads;
# 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
#PR30333 - sort() crash with threads
sub mycmp { length($b) <=> length($a) }
sub do_sort_one_thread {
my $kid = shift;
print "# kid $kid before sort\n";
my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
'hello', 's', 'thisisalongname', '1', '2', '3',
'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
for my $j (1..99999) {
for my $k (sort mycmp @list) {}
}
print "# kid $kid after sort, sleeping 1\n";
sleep(1);
print "# kid $kid exit\n";
}
sub do_sort_threads {
my $nthreads = shift;
my @kids = ();
for my $i (1..$nthreads) {
my $t = threads->new(\&do_sort_one_thread, $i);
print "# parent $$: continue\n";
push(@kids, $t);
}
for my $t (@kids) {
print "# parent $$: waiting for join\n";
$t->join();
print "# parent $$: thread exited\n";
}
}
do_sort_threads(2); # crashes
ok(1);
# Change 24643 made the mistake of assuming that CvCONST can only be true on
# XSUBs. Somehow it can also end up on perl subs.
fresh_perl_is(<<'EOI', 'ok', { }, 'cloning constant subs');
use constant x=>1;
use threads;
$SIG{__WARN__} = sub{};
async sub {};
print "ok";
EOI
# From a test case by Tim Bunce in
# http://www.nntp.perl.org/group/perl.perl5.porters/63123
fresh_perl_is(<<'EOI', 'ok', { }, 'Ensure PL_linestr can be cloned');
use threads;
print do 'op/threads_create.pl' || die $@;
EOI
|
