threads 1.28
[p5sagit/p5-mst-13.2.git] / ext / threads / t / end.t
CommitLineData
0f1612a7 1use strict;
2use warnings;
4e00007d 3
4BEGIN {
0f1612a7 5 if ($ENV{'PERL_CORE'}){
6 chdir 't';
7 unshift @INC, '../lib';
8 }
9 use Config;
fc04eb16 10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12 exit(0);
4e00007d 13 }
14}
15
16use ExtUtils::testlib;
0f1612a7 17
4e00007d 18use threads;
19use threads::shared;
20
fc04eb16 21BEGIN {
22 $| = 1;
23 print("1..6\n"); ### Number of tests that will be run ###
24};
25
26my $TEST = 1;
27share($TEST);
28
29ok(1, 'Loaded');
4e00007d 30
31sub ok {
32 my ($ok, $name) = @_;
33
fc04eb16 34 lock($TEST);
35 my $id = $TEST++;
f2cba68d 36
4e00007d 37 # You have to do it this way or VMS will get confused.
fc04eb16 38 if ($ok) {
39 print("ok $id - $name\n");
40 } else {
41 print("not ok $id - $name\n");
42 printf("# Failed test at line %d\n", (caller)[2]);
43 }
4e00007d 44
fc04eb16 45 return ($ok);
4e00007d 46}
fc04eb16 47
48
49### Start of Testing ###
50
51# Test that END blocks are run in the thread that created them,
52# and not in any child threads.
53
54END {
55 ok(1, 'Main END block')
56}
57
58threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
59threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
4e00007d 60
61sub thread {
fc04eb16 62 eval "END { ok(1, '4th thread END block') }";
63 threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
4e00007d 64}
fc04eb16 65threads->create(\&thread)->join();
66
67# EOF