10 if (!$Config::Config{useithreads}) {
11 print "1..0 # Skip: no ithreads\n";
14 if ($ENV{PERL_CORE_MINITEST}) {
15 print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
26 # test that we don't get:
27 # Attempt to free unreferenced scalar: SV 0x40173f3c
28 fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
30 threads->create(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
35 # test that we don't get:
36 # Attempt to free unreferenced scalar: SV 0x814e0dc.
37 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
43 Scalar::Util::weaken($copy);
44 threads->create(sub { 1 })->join for (1..1);
49 # test that we don't get:
50 # panic: magic_killbackrefs.
52 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
54 sub new { bless {},shift }
57 use Scalar::Util qw(weaken);
58 my $object = Foo->new;
61 threads->create(sub { $ref = $object } )->join; # $ref = $object causes problems
65 #PR30333 - sort() crash with threads
66 sub mycmp { length($b) <=> length($a) }
68 sub do_sort_one_thread {
70 print "# kid $kid before sort\n";
71 my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
72 'hello', 's', 'thisisalongname', '1', '2', '3',
73 'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
75 for my $j (1..99999) {
76 for my $k (sort mycmp @list) {}
78 print "# kid $kid after sort, sleeping 1\n";
80 print "# kid $kid exit\n";
86 for my $i (1..$nthreads) {
87 my $t = threads->create(\&do_sort_one_thread, $i);
88 print "# parent $$: continue\n";
92 print "# parent $$: waiting for join\n";
94 print "# parent $$: thread exited\n";
98 do_sort_threads(2); # crashes
101 # Change 24643 made the mistake of assuming that CvCONST can only be true on
102 # XSUBs. Somehow it can also end up on perl subs.
103 fresh_perl_is(<<'EOI', 'ok', { }, 'cloning constant subs');
106 $SIG{__WARN__} = sub{};
111 # From a test case by Tim Bunce in
112 # http://www.nntp.perl.org/group/perl.perl5.porters/63123
113 fresh_perl_is(<<'EOI', 'ok', { }, 'Ensure PL_linestr can be cloned');
115 print do 'op/threads_create.pl' || die $@;
120 no strict 'vars'; # Accessing $TODO from test.pl
121 local $TODO = 'refcount issues with threads';
124 foreach my $BLOCK (qw(CHECK INIT)) {
125 fresh_perl_is(<<EOI, 'ok', { }, "threads in $BLOCK block");
127 $BLOCK { threads->create(sub {})->join; }
135 fresh_perl_is(<<'EOI', 'ok', { }, 'Bug #41138');
141 threads->create(sub {})->join();
147 # [perl #45053] Memory corruption with heavy module loading in threads
149 # run-time usage of newCONSTSUB (as done by the IO boot code) wasn't
150 # thread-safe - got occasional coredumps or malloc corruption
152 local $SIG{__WARN__} = sub {}; # Ignore any thread creation failure warnings
155 my $thr = threads->create( sub { require IO });
156 last if !defined($thr); # Probably ran out of memory
160 ok(1, '[perl #45053]');
164 is (ref $_[1], "Regexp");
168 threads->new(\&matchit, "Pie", qr/pie/i)->join();
170 # tests in threads don't get counted, so
171 curr_test(curr_test() + 2);
174 # the seen_evals field of a regexp was getting zeroed on clone, so
175 # within a thread it didn't know that a regex object contrained a 'safe'
176 # re_eval expression, so it later died with 'Eval-group not allowed' when
177 # you tried to interpolate the object
180 my $re = qr/(?{1})/; # this is literal, so safe
181 eval { "a" =~ /$re$re/ }; # interpolating safe values, so safe
182 ok($@ eq "", 'clone seen-evals');
184 threads->new(\&safe_re)->join();
186 # tests in threads don't get counted, so
187 curr_test(curr_test() + 1);
189 # This used to crash in 5.10.0 [perl #64954]
192 threads->new(sub {})->join;
193 pass("undefing a typeglob doesn't cause a crash during cloning");
197 # panic: del_backref during global destruction.
198 # when returning a non-closure sub from a thread and subsequently starting
200 fresh_perl_is(<<'EOI', 'ok', { }, 'No del_backref panic [perl #70748]');
202 sub foo { return (sub { }); }
203 my $bar = threads->create(\&foo)->join();
204 threads->create(sub { })->join();
208 # Another, more reliable test for the same del_backref bug:
210 <<' EOJ', qr/ok/, {}, 'No del_backref panic [perl #70748] (2)'
212 push @bar, threads->create(sub{sub{}})->join() for 1...10;
217 # Simple closure-returning test: At least this case works (though it
218 # leaks), and we don't want to break it.
219 fresh_perl_like(<<'EOJ', qr/^foo\n/, {}, 'returning a closure');
221 print create threads sub {
228 # At the point of thread creation, $h{1} is on the temps stack.
229 # The weak reference $a, however, is visible from the symbol table.
230 fresh_perl_is(<<'EOI', 'ok', { }, 'Test for 34394ecd06e704e9');
233 use Scalar::Util 'weaken';
236 delete $h{1} && threads->create(sub {}, shift)->join();