xref: /openbsd-src/gnu/usr.bin/perl/dist/threads/t/list.t (revision b39c515898423c8d899e35282f4b395f7cad3298)
1*b39c5158Smillertuse strict;
2*b39c5158Smillertuse warnings;
3*b39c5158Smillert
4*b39c5158SmillertBEGIN {
5*b39c5158Smillert    use Config;
6*b39c5158Smillert    if (! $Config{'useithreads'}) {
7*b39c5158Smillert        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8*b39c5158Smillert        exit(0);
9*b39c5158Smillert    }
10*b39c5158Smillert}
11*b39c5158Smillert
12*b39c5158Smillertuse ExtUtils::testlib;
13*b39c5158Smillert
14*b39c5158Smillertsub ok {
15*b39c5158Smillert    my ($id, $ok, $name) = @_;
16*b39c5158Smillert
17*b39c5158Smillert    # You have to do it this way or VMS will get confused.
18*b39c5158Smillert    if ($ok) {
19*b39c5158Smillert        print("ok $id - $name\n");
20*b39c5158Smillert    } else {
21*b39c5158Smillert        print("not ok $id - $name\n");
22*b39c5158Smillert        printf("# Failed test at line %d\n", (caller)[2]);
23*b39c5158Smillert    }
24*b39c5158Smillert
25*b39c5158Smillert    return ($ok);
26*b39c5158Smillert}
27*b39c5158Smillert
28*b39c5158SmillertBEGIN {
29*b39c5158Smillert    $| = 1;
30*b39c5158Smillert    print("1..15\n");   ### Number of tests that will be run ###
31*b39c5158Smillert};
32*b39c5158Smillert
33*b39c5158Smillertuse threads;
34*b39c5158Smillertok(1, 1, 'Loaded');
35*b39c5158Smillert
36*b39c5158Smillert### Start of Testing ###
37*b39c5158Smillert
38*b39c5158Smillertok(2, scalar @{[threads->list()]} == 0, 'No threads yet');
39*b39c5158Smillert
40*b39c5158Smillertthreads->create(sub {})->join();
41*b39c5158Smillertok(3, scalar @{[threads->list()]} == 0, 'Empty thread list after join');
42*b39c5158Smillert
43*b39c5158Smillertmy $thread = threads->create(sub {});
44*b39c5158Smillertok(4, scalar(threads->list()) == 1, 'Non-empty thread list');
45*b39c5158Smillertok(5, threads->list() == 1,             'Non-empty thread list');
46*b39c5158Smillert$thread->join();
47*b39c5158Smillertok(6, scalar @{[threads->list()]} == 0, 'Thread list empty again');
48*b39c5158Smillertok(7, threads->list() == 0,             'Thread list empty again');
49*b39c5158Smillert
50*b39c5158Smillert$thread = threads->create(sub {
51*b39c5158Smillert    ok(8, threads->list() == 1, 'Non-empty thread list in thread');
52*b39c5158Smillert    ok(9, threads->self == (threads->list())[0], 'Self in thread list')
53*b39c5158Smillert});
54*b39c5158Smillert
55*b39c5158Smillertthreads->yield; # help out non-preemptive thread implementations
56*b39c5158Smillertsleep 1;
57*b39c5158Smillert
58*b39c5158Smillertok(10, scalar(threads->list()) == 1, 'Thread count 1');
59*b39c5158Smillertok(11, threads->list() == 1,             'Thread count 1');
60*b39c5158Smillertmy $cnt = threads->list();
61*b39c5158Smillertok(12, $cnt == 1,                        'Thread count 1');
62*b39c5158Smillertmy ($thr_x) = threads->list();
63*b39c5158Smillertok(13, $thread == $thr_x,                'Thread in list');
64*b39c5158Smillert$thread->join();
65*b39c5158Smillertok(14, scalar @{[threads->list()]} == 0, 'Thread list empty');
66*b39c5158Smillertok(15, threads->list() == 0,             'Thread list empty');
67*b39c5158Smillert
68*b39c5158Smillertexit(0);
69*b39c5158Smillert
70*b39c5158Smillert# EOF
71