This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads 1.32
[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 = 1;
35 share($TEST);
36
37 ok(1, 'Loaded');
38
39 sub ok {
40     my ($ok, $name) = @_;
41
42     lock($TEST);
43     my $id = $TEST++;
44
45     # You have to do it this way or VMS will get confused.
46     if ($ok) {
47         print("ok $id - $name\n");
48     } else {
49         print("not ok $id - $name\n");
50         printf("# Failed test at line %d\n", (caller)[2]);
51     }
52
53     return ($ok);
54 }
55
56
57 ### Start of Testing ###
58
59 # Test that END blocks are run in the thread that created them,
60 # and not in any child threads.
61
62 END {
63     ok(1, 'Main END block')
64 }
65
66 threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
67 threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
68
69 sub thread {
70     eval "END { ok(1, '4th thread END block') }";
71     threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
72 }
73 threads->create(\&thread)->join();
74
75 # EOF