This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Work in non core env.
[perl5.git] / ext / threads / t / end.t
1
2 # test that END blocks are run in the thread that created them and
3 # not in any child threads
4
5 BEGIN {
6     chdir 't' if -d 't';
7     push @INC, '../lib';
8     require Config; import Config;
9     unless ($Config{'useithreads'}) {
10         print "1..0 # Skip: no useithreads\n";
11         exit 0;
12     }
13 }
14
15 use ExtUtils::testlib;
16 use strict;
17 BEGIN { print "1..6\n" };
18 use threads;
19 use threads::shared;
20
21 my $test_id = 1;
22 share($test_id);
23 use Devel::Peek qw(Dump);
24
25 sub ok {
26     my ($ok, $name) = @_;
27
28     # You have to do it this way or VMS will get confused.
29     print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
30
31     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
32     $test_id++;
33     return $ok;
34 }
35 ok(1);
36 END { ok(1,"End block run once") }
37 threads->create(sub { eval "END { ok(1,'') }"})->join();
38 threads->create(sub { eval "END { ok(1,'') }"})->join();
39 threads->create(\&thread)->join();
40
41 sub thread {
42         eval "END { ok(1,'') }";
43         threads->create(sub { eval "END { ok(1,'') }"})->join();
44 }