5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
16 use ExtUtils::testlib;
22 require threads::shared;
23 import threads::shared;
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
31 print("1..5\n"); ### Number of tests that will be run ###
34 my ($TEST, $COUNT, $TOTAL);
52 # You have to do it this way or VMS will get confused.
54 print("ok $id - $name\n");
56 print("not ok $id - $name\n");
57 printf("# Failed test at line %d\n", (caller)[2]);
58 print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
65 ### Start of Testing ###
67 $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
69 sub foo { lock($COUNT); $COUNT++; }
74 $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
77 threads->create('foo')->join();
79 threads->create(\&foo)->join();
81 threads->create(sub { lock($COUNT); $COUNT++; })->join();
84 threads->create('foo')->detach();
86 threads->create(\&foo)->detach();
88 threads->create(sub { lock($COUNT); $COUNT++; })->detach();
90 $bthr = threads->create('baz');
96 threads->create('foo')->join();
98 threads->create(\&foo)->join();
100 threads->create(sub { lock($COUNT); $COUNT++; })->join();
103 threads->create('foo')->detach();
105 threads->create(\&foo)->detach();
107 threads->create(sub { lock($COUNT); $COUNT++; })->detach();
109 $mthr = threads->create('baz');
112 ok($mthr, 'Main thread');
113 ok($bthr, 'BEGIN thread');
115 ok($mthr->join() == 42, 'Main join');
116 ok($bthr->join() == 42, 'BEGIN join');
118 # Wait for detached threads to finish
123 redo if ($COUNT < $TOTAL);