5 require './test.pl'; # for which_perl() etc
12 if (!$Config{useithreads}) {
13 print "1..0 # Skip: no ithreads\n";
16 if ($ENV{PERL_CORE_MINITEST}) {
17 print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
24 # test that we don't get:
25 # Attempt to free unreferenced scalar: SV 0x40173f3c
26 fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
28 threads->new(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
33 # test that we don't get:
34 # Attempt to free unreferenced scalar: SV 0x814e0dc.
35 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
41 Scalar::Util::weaken($copy);
42 threads->new(sub { 1 })->join for (1..1);
47 # test that we don't get:
48 # panic: magic_killbackrefs.
50 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
52 sub new { bless {},shift }
55 use Scalar::Util qw(weaken);
56 my $object = Foo->new;
59 threads->new(sub { $ref = $object } )->join; # $ref = $object causes problems
63 #PR30333 - sort() crash with threads
64 sub mycmp { length($b) <=> length($a) }
66 sub do_sort_one_thread {
68 print "# kid $kid before sort\n";
69 my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
70 'hello', 's', 'thisisalongname', '1', '2', '3',
71 'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
73 for my $j (1..99999) {
74 for my $k (sort mycmp @list) {}
76 print "# kid $kid after sort, sleeping 1\n";
78 print "# kid $kid exit\n";
84 for my $i (1..$nthreads) {
85 my $t = threads->new(\&do_sort_one_thread, $i);
86 print "# parent $$: continue\n";
90 print "# parent $$: waiting for join\n";
92 print "# parent $$: thread exited\n";
96 do_sort_threads(2); # crashes