13 if (!$Config{useithreads}) {
14 print "1..0 # Skip: no ithreads\n";
17 if ($ENV{PERL_CORE_MINITEST}) {
18 print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
25 # test that we don't get:
26 # Attempt to free unreferenced scalar: SV 0x40173f3c
27 fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
29 threads->create(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
34 # test that we don't get:
35 # Attempt to free unreferenced scalar: SV 0x814e0dc.
36 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
42 Scalar::Util::weaken($copy);
43 threads->create(sub { 1 })->join for (1..1);
48 # test that we don't get:
49 # panic: magic_killbackrefs.
51 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
53 sub new { bless {},shift }
56 use Scalar::Util qw(weaken);
57 my $object = Foo->new;
60 threads->create(sub { $ref = $object } )->join; # $ref = $object causes problems
64 #PR30333 - sort() crash with threads
65 sub mycmp { length($b) <=> length($a) }
67 sub do_sort_one_thread {
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' );
74 for my $j (1..99999) {
75 for my $k (sort mycmp @list) {}
77 print "# kid $kid after sort, sleeping 1\n";
79 print "# kid $kid exit\n";
85 for my $i (1..$nthreads) {
86 my $t = threads->create(\&do_sort_one_thread, $i);
87 print "# parent $$: continue\n";
91 print "# parent $$: waiting for join\n";
93 print "# parent $$: thread exited\n";
97 do_sort_threads(2); # crashes
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.
102 fresh_perl_is(<<'EOI', 'ok', { }, 'cloning constant subs');
105 $SIG{__WARN__} = sub{};
110 # From a test case by Tim Bunce in
111 # http://www.nntp.perl.org/group/perl.perl5.porters/63123
112 fresh_perl_is(<<'EOI', 'ok', { }, 'Ensure PL_linestr can be cloned');
114 print do 'op/threads_create.pl' || die $@;
117 # Attempt to free unreferenced scalar...
118 fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via scalar');
121 threads->create($test)->join();
125 # Attempt to free unreferenced scalar...
126 fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via $_[0]');
128 sub thr { threads->new($_[0]); }
134 no strict 'vars'; # Accessing $TODO from test.pl
135 local $TODO = 'refcount issues with threads';
140 foreach my $BLOCK (qw(CHECK INIT)) {
141 fresh_perl_is(<<EOI, 'ok', { }, "threads in $BLOCK block");
143 $BLOCK { threads->create(sub {})->join; }
149 fresh_perl_is(<<'EOI', 'ok', { }, 'Bug #41138');
155 threads->create(sub {})->join();