This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add TODO tests for refcount issues related to threads
[perl5.git] / t / op / threads.t
1 #!./perl
2 BEGIN {
3      chdir 't' if -d 't';
4      @INC = '../lib';
5      require './test.pl';
6      $| = 1;
7 }
8
9 use strict;
10 use Config;
11
12 BEGIN {
13      if (!$Config{useithreads}) {
14         print "1..0 # Skip: no ithreads\n";
15         exit 0;
16      }
17      if ($ENV{PERL_CORE_MINITEST}) {
18        print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
19        exit 0;
20      }
21      plan(11);
22 }
23 use threads;
24
25 # test that we don't get:
26 # Attempt to free unreferenced scalar: SV 0x40173f3c
27 fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
28 use threads;
29 threads->create(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
30 print "ok";
31 EOI
32
33 #PR24660
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');
37 use threads;
38 use Scalar::Util;
39 my $data = "a";
40 my $obj = \$data;
41 my $copy = $obj;
42 Scalar::Util::weaken($copy);
43 threads->create(sub { 1 })->join for (1..1);
44 print "ok";
45 EOI
46
47 #PR24663
48 # test that we don't get:
49 # panic: magic_killbackrefs.
50 # Scalars leaked: 3
51 fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
52 package Foo;
53 sub new { bless {},shift }
54 package main;
55 use threads;
56 use Scalar::Util qw(weaken);
57 my $object = Foo->new;
58 my $ref = $object;
59 weaken $ref;
60 threads->create(sub { $ref = $object } )->join; # $ref = $object causes problems
61 print "ok";
62 EOI
63
64 #PR30333 - sort() crash with threads
65 sub mycmp { length($b) <=> length($a) }
66
67 sub 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
82 sub do_sort_threads {
83    my $nthreads = shift;
84    my @kids = ();
85    for my $i (1..$nthreads) {
86       my $t = threads->create(\&do_sort_one_thread, $i);
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
97 do_sort_threads(2);        # crashes
98 ok(1);
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.
102 fresh_perl_is(<<'EOI', 'ok', { }, 'cloning constant subs');
103 use constant x=>1;
104 use threads;
105 $SIG{__WARN__} = sub{};
106 async sub {};
107 print "ok";
108 EOI
109
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');
113 use threads;
114 print do 'op/threads_create.pl' || die $@;
115 EOI
116
117
118 TODO: {
119     no strict 'vars';   # Accessing $TODO from test.pl
120     local $TODO = 'refcount issues with threads';
121
122 # Attempt to free unreferenced scalar...
123 fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via scalar');
124     use threads;
125     my $test = sub {};
126     threads->create($test)->join();
127     print 'ok';
128 EOI
129
130 # Attempt to free unreferenced scalar...
131 fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via $_[0]');
132     use threads;
133     sub thr { threads->new($_[0]); }
134     thr(sub { })->join;
135     print 'ok';
136 EOI
137
138 # Scalars leaked: 1
139 foreach my $BLOCK (qw(CHECK INIT)) {
140     fresh_perl_is(<<EOI, 'ok', { }, "threads in $BLOCK block");
141         use threads;
142         $BLOCK { threads->create(sub {})->join; }
143         print 'ok';
144 EOI
145 }
146
147 # Scalars leaked: 1
148 fresh_perl_is(<<'EOI', 'ok', { }, 'Bug #41138');
149     use threads;
150     leak($x);
151     sub leak
152     {
153         local $x;
154         threads->create(sub {})->join();
155     }
156     print 'ok';
157 EOI
158
159 } # TODO
160
161 # EOF