This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
two test failures
[perl5.git] / ext / threads / t / basic.t
1
2
3 #
4 # The reason this does not use a Test module is that
5 # they mess up test numbers between threads
6 #
7 # And even when that will be fixed, this is a basic
8 # test and should not rely on shared variables
9
10 #
11 #########################
12
13
14 BEGIN {
15     chdir 't' if -d 't';
16     @INC = '../lib';
17     require Config; import Config;
18     unless ($Config{'useithreads'}) {
19         print "1..0 # Skip: no useithreads\n";
20         exit 0; 
21     }
22 }
23
24 use ExtUtils::testlib;
25 use strict;
26 BEGIN { print "1..12\n" };
27 use threads;
28
29
30
31 print "ok 1\n";
32
33
34 #########################
35
36 # Insert your test code below, the Test module is use()ed here so read
37 # its man page ( perldoc Test ) for help writing this test script.
38 #my $bar;
39 sub ok {        
40     my ($id, $ok, $name) = @_;
41     
42     # You have to do it this way or VMS will get confused.
43     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
44
45     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
46     
47     return $ok;
48 }
49
50
51
52
53 #test passing of simple argument
54 my $thread = threads->create(sub { ok(2, 'bar' eq $_[0]),"" },"bar");
55 $thread->join();
56
57
58 #test passing of complex argument
59
60 $thread = threads->create(sub { ok(3, 'bar' eq $_[0]->[0]->{foo})},[{foo => 'bar'}]);
61
62 $thread->join();
63
64
65 #test execuion of normal sub
66 sub bar { ok(4,shift() == 1,"") }
67 threads->create(\&bar,1)->join();
68
69
70 #check Config
71 ok(5, 1 == $Config::threads,"");
72
73 #test trying to detach thread
74
75 my $thread1 = threads->create(sub {ok(6,1,"")});
76
77 $thread1->detach();
78 sleep 1;
79 ok(7,1,"");
80 #create nested threads
81 unless($^O eq 'MSWin32') {
82         my $thread3 = threads->create(sub { threads->create(sub {})})->join();
83 }
84
85
86 my @threads;
87 my $i;
88 unless($^O eq 'MSWin32') {
89 for(1..25) {    
90         push @threads, threads->create(sub { for(1..100000) { my $i  } threads->create(sub { sleep 2})->join() });
91 }
92 foreach my $thread (@threads) {
93         $thread->join();
94 }
95 }
96 ok(8,1,"");
97 threads->create(sub { 
98     my $self = threads->self();
99     ok(9,$self->tid() == 57,"");
100 })->join();
101 threads->create(sub { 
102     my $self = threads->self();
103     ok(10,$self->tid() == 58,"");
104 })->join();
105
106 #check support for threads->self() in main thread
107 ok(11, 0 == threads->self->tid(),"");
108 ok(12, 0 == threads->tid(),"Check so that tid for threads work for current tid");
109
110
111
112
113
114
115
116
117
118