This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate most of the UTF-8 black smoke by skipping optree tests when
[perl5.git] / ext / threads / t / blocks.t
CommitLineData
f2e0bb91
JH
1use strict;
2use warnings;
3
4BEGIN {
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
16use ExtUtils::testlib;
17
18use threads;
19use threads::shared;
20
21my $TEST;
22BEGIN {
23 $| = 1;
24 print("1..5\n"); ### Number of tests that will be run ###
25
26 share($TEST);
27 $TEST = 1;
28};
29
30ok(1, 'Loaded');
31
32sub ok {
33 my ($ok, $name) = @_;
34
35 lock($TEST);
36 my $id = $TEST++;
37
38 # You have to do it this way or VMS will get confused.
39 if ($ok) {
40 print("ok $id - $name\n");
41 } else {
42 print("not ok $id - $name\n");
43 printf("# Failed test at line %d\n", (caller)[2]);
44 }
45
46 return ($ok);
47}
48
49
50### Start of Testing ###
51
52$SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); };
53
54sub foo { }
55sub baz { 42 }
56
57my $bthr;
58BEGIN {
59 $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); };
60
61 threads->create('foo')->join();
62 threads->create(\&foo)->join();
63 threads->create(sub {})->join();
64
65 threads->create('foo')->detach();
66 threads->create(\&foo)->detach();
67 threads->create(sub {})->detach();
68
69 $bthr = threads->create('baz');
70}
71
72my $mthr;
73MAIN: {
74 threads->create('foo')->join();
75 threads->create(\&foo)->join();
76 threads->create(sub {})->join();
77
78 threads->create('foo')->detach();
79 threads->create(\&foo)->detach();
80 threads->create(sub {})->detach();
81
82 $mthr = threads->create('baz');
83}
84
85ok($mthr, 'Main thread');
86ok($bthr, 'BEGIN thread');
87
88ok($mthr->join() == 42, 'Main join');
89ok($bthr->join() == 42, 'BEGIN join');
90
91# EOF