1use strict; 2use warnings; 3 4BEGIN { 5 use Config; 6 if (! $Config{'useithreads'}) { 7 print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); 8 exit(0); 9 } 10} 11 12use ExtUtils::testlib; 13 14use threads; 15 16BEGIN { 17 if (! eval 'use threads::shared; 1') { 18 print("1..0 # SKIP threads::shared not available\n"); 19 exit(0); 20 } 21 22 $| = 1; 23 print("1..31\n"); ### Number of tests that will be run ### 24}; 25 26my $TEST; 27BEGIN { 28 share($TEST); 29 $TEST = 1; 30} 31 32ok(1, 'Loaded'); 33 34sub ok { 35 my ($ok, $name) = @_; 36 37 lock($TEST); 38 my $id = $TEST++; 39 40 # You have to do it this way or VMS will get confused. 41 if ($ok) { 42 print("ok $id - $name\n"); 43 } else { 44 print("not ok $id - $name\n"); 45 printf("# Failed test at line %d\n", (caller)[2]); 46 } 47 48 return ($ok); 49} 50 51 52### Start of Testing ### 53 54sub foo 55{ 56 my $context = shift; 57 my $wantarray = wantarray(); 58 59 if ($wantarray) { 60 ok($context eq 'array', 'Array/list context'); 61 return ('array'); 62 } elsif (defined($wantarray)) { 63 ok($context eq 'scalar', 'Scalar context'); 64 return 'scalar'; 65 } else { 66 ok($context eq 'void', 'Void context'); 67 return; 68 } 69} 70 71my ($thr) = threads->create('foo', 'array'); 72my ($res) = $thr->join(); 73ok($res eq 'array', 'Implicit array context'); 74 75$thr = threads->create('foo', 'scalar'); 76$res = $thr->join(); 77ok($res eq 'scalar', 'Implicit scalar context'); 78 79threads->create('foo', 'void'); 80($thr) = threads->list(); 81$res = $thr->join(); 82ok(! defined($res), 'Implicit void context'); 83 84$thr = threads->create({'context' => 'array'}, 'foo', 'array'); 85($res) = $thr->join(); 86ok($res eq 'array', 'Explicit array context'); 87 88($thr) = threads->create({'scalar' => 'scalar'}, 'foo', 'scalar'); 89$res = $thr->join(); 90ok($res eq 'scalar', 'Explicit scalar context'); 91 92$thr = threads->create({'void' => 1}, 'foo', 'void'); 93$res = $thr->join(); 94ok(! defined($res), 'Explicit void context'); 95 96 97sub bar 98{ 99 my $context = shift; 100 my $wantarray = threads->wantarray(); 101 102 if ($wantarray) { 103 ok($context eq 'list', 'Array/list context'); 104 return ('list'); 105 } elsif (defined($wantarray)) { 106 ok($context eq 'scalar', 'Scalar context'); 107 return 'scalar'; 108 } else { 109 ok($context eq 'void', 'Void context'); 110 return; 111 } 112} 113 114($thr) = threads->create('bar', 'list'); 115my $ctx = $thr->wantarray(); 116ok($ctx, 'Implicit array context'); 117($res) = $thr->join(); 118ok($res eq 'list', 'Implicit array context'); 119 120$thr = threads->create('bar', 'scalar'); 121$ctx = $thr->wantarray(); 122ok(defined($ctx) && !$ctx, 'Implicit scalar context'); 123$res = $thr->join(); 124ok($res eq 'scalar', 'Implicit scalar context'); 125 126threads->create('bar', 'void'); 127($thr) = threads->list(); 128$ctx = $thr->wantarray(); 129ok(! defined($ctx), 'Implicit void context'); 130$res = $thr->join(); 131ok(! defined($res), 'Implicit void context'); 132 133$thr = threads->create({'context' => 'list'}, 'bar', 'list'); 134$ctx = $thr->wantarray(); 135ok($ctx, 'Explicit array context'); 136($res) = $thr->join(); 137ok($res eq 'list', 'Explicit array context'); 138 139($thr) = threads->create({'scalar' => 'scalar'}, 'bar', 'scalar'); 140$ctx = $thr->wantarray(); 141ok(defined($ctx) && !$ctx, 'Explicit scalar context'); 142$res = $thr->join(); 143ok($res eq 'scalar', 'Explicit scalar context'); 144 145$thr = threads->create({'void' => 1}, 'bar', 'void'); 146$ctx = $thr->wantarray(); 147ok(! defined($ctx), 'Explicit void context'); 148$res = $thr->join(); 149ok(! defined($res), 'Explicit void context'); 150 151exit(0); 152 153# EOF 154