Commit | Line | Data |
---|---|---|
f935b2f6 SB |
1 | #!./perl |
2 | BEGIN { | |
3 | chdir 't' if -d 't'; | |
996dc718 | 4 | @INC = '../lib'; |
f935b2f6 | 5 | require './test.pl'; # for which_perl() etc |
57690963 | 6 | $| = 1; |
f935b2f6 SB |
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 | } | |
6765206c NC |
17 | if ($ENV{PERL_CORE_MINITEST}) { |
18 | print "1..0 # Skip: no dynamic loading on miniperl, no threads\n"; | |
19 | exit 0; | |
f935b2f6 | 20 | } |
cfae286e | 21 | plan(5); |
f935b2f6 | 22 | } |
6765206c | 23 | use threads; |
f935b2f6 SB |
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->new(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->new(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->new(sub { $ref = $object } )->join; # $ref = $object causes problems | |
61 | print "ok"; | |
62 | EOI | |
9850bf21 RH |
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->new(\&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); | |
cfae286e NC |
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 |