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..31\n"); ### Number of tests that will be run ###
48 # You have to do it this way or VMS will get confused.
50 print("ok $id - $name\n");
52 print("not ok $id - $name\n");
53 printf("# Failed test at line %d\n", (caller)[2]);
60 ### Start of Testing ###
65 my $wantarray = wantarray();
68 ok($context eq 'array', 'Array context');
70 } elsif (defined($wantarray)) {
71 ok($context eq 'scalar', 'Scalar context');
74 ok($context eq 'void', 'Void context');
79 my ($thr) = threads->create('foo', 'array');
80 my ($res) = $thr->join();
81 ok($res eq 'array', 'Implicit array context');
83 $thr = threads->create('foo', 'scalar');
85 ok($res eq 'scalar', 'Implicit scalar context');
87 threads->create('foo', 'void');
88 ($thr) = threads->list();
90 ok(! defined($res), 'Implicit void context');
92 $thr = threads->create({'context' => 'array'}, 'foo', 'array');
93 ($res) = $thr->join();
94 ok($res eq 'array', 'Explicit array context');
96 ($thr) = threads->create({'scalar' => 'scalar'}, 'foo', 'scalar');
98 ok($res eq 'scalar', 'Explicit scalar context');
100 $thr = threads->create({'void' => 1}, 'foo', 'void');
102 ok(! defined($res), 'Explicit void context');
108 my $wantarray = threads->wantarray();
111 ok($context eq 'array', 'Array context');
113 } elsif (defined($wantarray)) {
114 ok($context eq 'scalar', 'Scalar context');
117 ok($context eq 'void', 'Void context');
122 ($thr) = threads->create('bar', 'array');
123 my $ctx = $thr->wantarray();
124 ok($ctx, 'Implicit array context');
125 ($res) = $thr->join();
126 ok($res eq 'array', 'Implicit array context');
128 $thr = threads->create('bar', 'scalar');
129 $ctx = $thr->wantarray();
130 ok(defined($ctx) && !$ctx, 'Implicit scalar context');
132 ok($res eq 'scalar', 'Implicit scalar context');
134 threads->create('bar', 'void');
135 ($thr) = threads->list();
136 $ctx = $thr->wantarray();
137 ok(! defined($ctx), 'Implicit void context');
139 ok(! defined($res), 'Implicit void context');
141 $thr = threads->create({'context' => 'array'}, 'bar', 'array');
142 $ctx = $thr->wantarray();
143 ok($ctx, 'Explicit array context');
144 ($res) = $thr->join();
145 ok($res eq 'array', 'Explicit array context');
147 ($thr) = threads->create({'scalar' => 'scalar'}, 'bar', 'scalar');
148 $ctx = $thr->wantarray();
149 ok(defined($ctx) && !$ctx, 'Explicit scalar context');
151 ok($res eq 'scalar', 'Explicit scalar context');
153 $thr = threads->create({'void' => 1}, 'bar', 'void');
154 $ctx = $thr->wantarray();
155 ok(! defined($ctx), 'Explicit void context');
157 ok(! defined($res), 'Explicit void context');