4 # The reason this does not use a Test module is that
5 # they mess up test numbers between threads
7 # And even when that will be fixed, this is a basic
8 # test and should not rely on shared variables
11 #########################
17 require Config; import Config;
18 unless ($Config{'useithreads'}) {
19 print "1..0 # Skip: no useithreads\n";
24 use ExtUtils::testlib;
26 BEGIN { print "1..12\n" };
34 #########################
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.
40 my ($id, $ok, $name) = @_;
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";
45 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
53 #test passing of simple argument
54 my $thread = threads->create(sub { ok(2, 'bar' eq $_[0]),"" },"bar");
58 #test passing of complex argument
60 $thread = threads->create(sub { ok(3, 'bar' eq $_[0]->[0]->{foo})},[{foo => 'bar'}]);
65 #test execuion of normal sub
66 sub bar { ok(4,shift() == 1,"") }
67 threads->create(\&bar,1)->join();
71 ok(5, 1 == $Config::threads,"");
73 #test trying to detach thread
75 my $thread1 = threads->create(sub {ok(6,1,"")});
80 #create nested threads
81 unless($^O eq 'MSWin32') {
82 my $thread3 = threads->create(sub { threads->create(sub {})})->join();
86 unless($^O eq 'MSWin32') {
93 for(1..100000) { my $i }
100 foreach my $thread (@threads) {
105 threads->create(sub {
106 my $self = threads->self();
107 ok(9,$self->tid() == 57,"");
109 threads->create(sub {
110 my $self = threads->self();
111 ok(10,$self->tid() == 58,"");
114 #check support for threads->self() in main thread
115 ok(11, 0 == threads->self->tid(),"");
116 ok(12, 0 == threads->tid(),"Check so that tid for threads work for current tid");