Upgrade to threads 1.72
[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'}) {
561ee912 11 print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
fc04eb16 12 exit(0);
4e00007d 13 }
14}
15
16use ExtUtils::testlib;
0f1612a7 17
4e00007d 18use threads;
4e00007d 19
fc04eb16 20BEGIN {
e301958b 21 if (! eval 'use threads::shared; 1') {
561ee912 22 print("1..0 # SKIP threads::shared not available\n");
58a3a76c 23 exit(0);
24 }
25
fc04eb16 26 $| = 1;
27 print("1..6\n"); ### Number of tests that will be run ###
28};
29
4dcb9e53 30my $TEST;
31BEGIN {
32 share($TEST);
33 $TEST = 1;
34}
fc04eb16 35
36ok(1, 'Loaded');
4e00007d 37
38sub ok {
39 my ($ok, $name) = @_;
40
fc04eb16 41 lock($TEST);
42 my $id = $TEST++;
f2cba68d 43
4e00007d 44 # You have to do it this way or VMS will get confused.
fc04eb16 45 if ($ok) {
46 print("ok $id - $name\n");
47 } else {
48 print("not ok $id - $name\n");
49 printf("# Failed test at line %d\n", (caller)[2]);
50 }
4e00007d 51
fc04eb16 52 return ($ok);
4e00007d 53}
fc04eb16 54
55
56### Start of Testing ###
57
58# Test that END blocks are run in the thread that created them,
59# and not in any child threads.
60
61END {
62 ok(1, 'Main END block')
63}
64
65threads->create(sub { eval "END { ok(1, '1st thread END block') }"})->join();
66threads->create(sub { eval "END { ok(1, '2nd thread END block') }"})->join();
4e00007d 67
68sub thread {
fc04eb16 69 eval "END { ok(1, '4th thread END block') }";
70 threads->create(sub { eval "END { ok(1, '5th thread END block') }"})->join();
4e00007d 71}
fc04eb16 72threads->create(\&thread)->join();
73
561ee912 74exit(0);
75
fc04eb16 76# EOF