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