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 if (! defined($name)) { 17*b39c5158Smillert $name = ''; 18*b39c5158Smillert } 19*b39c5158Smillert 20*b39c5158Smillert # You have to do it this way or VMS will get confused. 21*b39c5158Smillert if ($ok) { 22*b39c5158Smillert print("ok $id - $name\n"); 23*b39c5158Smillert } else { 24*b39c5158Smillert print("not ok $id - $name\n"); 25*b39c5158Smillert printf("# Failed test at line %d\n", (caller)[2]); 26*b39c5158Smillert } 27*b39c5158Smillert 28*b39c5158Smillert return ($ok); 29*b39c5158Smillert} 30*b39c5158Smillert 31*b39c5158SmillertBEGIN { 32*b39c5158Smillert $| = 1; 33*b39c5158Smillert print("1..101\n"); ### Number of tests that will be run ### 34*b39c5158Smillert}; 35*b39c5158Smillert 36*b39c5158Smillertuse threads; 37*b39c5158Smillertuse threads::shared; 38*b39c5158Smillertok(1, 1, 'Loaded'); 39*b39c5158Smillert 40*b39c5158Smillert### Start of Testing ### 41*b39c5158Smillert 42*b39c5158Smillertmy $test_count; 43*b39c5158Smillertshare($test_count); 44*b39c5158Smillert$test_count = 2; 45*b39c5158Smillert 46*b39c5158Smillertfor(1..10) { 47*b39c5158Smillert my $foo : shared = "foo"; 48*b39c5158Smillert ok($test_count++, $foo eq "foo"); 49*b39c5158Smillert threads->create(sub { $foo = "bar" })->join(); 50*b39c5158Smillert ok($test_count++, $foo eq "bar"); 51*b39c5158Smillert my @foo : shared = ("foo","bar"); 52*b39c5158Smillert ok($test_count++, $foo[1] eq "bar"); 53*b39c5158Smillert threads->create(sub { ok($test_count++, shift(@foo) eq "foo")})->join(); 54*b39c5158Smillert ok($test_count++, $foo[0] eq "bar"); 55*b39c5158Smillert my %foo : shared = ( foo => "bar" ); 56*b39c5158Smillert ok($test_count++, $foo{foo} eq "bar"); 57*b39c5158Smillert threads->create(sub { $foo{bar} = "foo" })->join(); 58*b39c5158Smillert ok($test_count++, $foo{bar} eq "foo"); 59*b39c5158Smillert 60*b39c5158Smillert threads->create(sub { $foo{array} = \@foo})->join(); 61*b39c5158Smillert threads->create(sub { push @{$foo{array}}, "baz"})->join(); 62*b39c5158Smillert ok($test_count++, $foo[-1] eq "baz"); 63*b39c5158Smillert} 64*b39c5158Smillert 65*b39c5158Smillertmy $shared :shared = &share({}); 66*b39c5158Smillert$$shared{'foo'} = 'bar'; 67*b39c5158Smillert 68*b39c5158Smillertfor(1..10) { 69*b39c5158Smillert my $str1 = "$shared"; 70*b39c5158Smillert my $str2 = "$shared"; 71*b39c5158Smillert ok($test_count++, $str1 eq $str2, 'stringify'); 72*b39c5158Smillert $str1 = $$shared{'foo'}; 73*b39c5158Smillert $str2 = $$shared{'foo'}; 74*b39c5158Smillert ok($test_count++, $str1 eq $str2, 'contents'); 75*b39c5158Smillert} 76*b39c5158Smillert 77*b39c5158Smillertexit(0); 78*b39c5158Smillert 79*b39c5158Smillert# EOF 80