This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
From #43633: Cwd::cwd() use in File::Spec::Unix use causes unnecessary fork()
[perl5.git] / ext / threads / t / end.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     if ($ENV{'PERL_CORE'}){
6         chdir 't';
7         unshift @INC, '../lib';
8     }
9     use Config;
10     if (! $Config{'useithreads'}) {
11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12         exit(0);
13     }
14 }
15
16 use ExtUtils::testlib;
17
18 use threads;
19
20 BEGIN {
21     eval {
22         require threads::shared;
23         import threads::shared;
24     };
25     if ($@ || ! $threads::shared::threads_shared) {
26         print("1..0 # Skip: threads::shared not available\n");
27         exit(0);
28     }
29
30     $| = 1;
31     print("1..6\n");   ### Number of tests that will be run ###
32 };
33
34 my $TEST;
35 BEGIN {
36     share($TEST);
37     $TEST = 1;
38 }
39
40 ok(1, 'Loaded');
41
42 sub ok {
43     my ($ok, $name) = @_;
44
45     lock($TEST);
46     my $id = $TEST++;
47
48     # You have to do it this way or VMS will get confused.
49     if ($ok) {
50         print("ok $id - $name\n");
51     } else {
52         print("not ok $id - $name\n");
53         printf("# Failed test at line %d\n", (caller)[2]);
54     }
55
56     return ($ok);
57 }
58
59
60 ### Start of Testing ###
61
62 # Test that END blocks are run in the thread that created them,
63 # and not in any child threads.
64
65 END {
66     ok(1, 'Main END block')
67 }
68
69 threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
70 threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
71
72 sub thread {
73     eval "END { ok(1, '4th thread END block') }";
74     threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
75 }
76 threads->create(\&thread)->join();
77
78 # EOF