This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads 1.64 (repost)
[perl5.git] / ext / threads / t / end.t
CommitLineData
0f1612a7
JH
1use strict;
2use warnings;
4e00007d
AB
3
4BEGIN {
0f1612a7
JH
5 if ($ENV{'PERL_CORE'}){
6 chdir 't';
7 unshift @INC, '../lib';
8 }
9 use Config;
fc04eb16
JH
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12 exit(0);
4e00007d
AB
13 }
14}
15
16use ExtUtils::testlib;
0f1612a7 17
4e00007d 18use threads;
4e00007d 19
fc04eb16 20BEGIN {
58a3a76c
JH
21 eval {
22 require threads::shared;
f3086ff0 23 threads::shared->import();
58a3a76c
JH
24 };
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
27 exit(0);
28 }
29
fc04eb16
JH
30 $| = 1;
31 print("1..6\n"); ### Number of tests that will be run ###
32};
33
4dcb9e53
JH
34my $TEST;
35BEGIN {
36 share($TEST);
37 $TEST = 1;
38}
fc04eb16
JH
39
40ok(1, 'Loaded');
4e00007d
AB
41
42sub ok {
43 my ($ok, $name) = @_;
44
fc04eb16
JH
45 lock($TEST);
46 my $id = $TEST++;
f2cba68d 47
4e00007d 48 # You have to do it this way or VMS will get confused.
fc04eb16
JH
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 }
4e00007d 55
fc04eb16 56 return ($ok);
4e00007d 57}
fc04eb16
JH
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
65END {
66 ok(1, 'Main END block')
67}
68
69threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
70threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
4e00007d
AB
71
72sub thread {
fc04eb16
JH
73 eval "END { ok(1, '4th thread END block') }";
74 threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
4e00007d 75}
fc04eb16
JH
76threads->create(\&thread)->join();
77
78# EOF