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 17*b39c5158Smillert # You have to do it this way or VMS will get confused. 18*b39c5158Smillert if ($ok) { 19*b39c5158Smillert print("ok $id - $name\n"); 20*b39c5158Smillert } else { 21*b39c5158Smillert print("not ok $id - $name\n"); 22*b39c5158Smillert printf("# Failed test at line %d\n", (caller)[2]); 23*b39c5158Smillert } 24*b39c5158Smillert 25*b39c5158Smillert return ($ok); 26*b39c5158Smillert} 27*b39c5158Smillert 28*b39c5158SmillertBEGIN { 29*b39c5158Smillert $| = 1; 30*b39c5158Smillert print("1..11\n"); ### Number of tests that will be run ### 31*b39c5158Smillert}; 32*b39c5158Smillert 33*b39c5158Smillertuse threads; 34*b39c5158Smillertuse threads::shared; 35*b39c5158Smillertok(1, 1, 'Loaded'); 36*b39c5158Smillert 37*b39c5158Smillert### Start of Testing ### 38*b39c5158Smillert 39*b39c5158Smillertmy $test = "bar"; 40*b39c5158Smillertshare($test); 41*b39c5158Smillertok(2,$test eq "bar","Test magic share fetch"); 42*b39c5158Smillert$test = "foo"; 43*b39c5158Smillertok(3,$test eq "foo","Test magic share assign"); 44*b39c5158Smillertmy $c = threads::shared::_refcnt($test); 45*b39c5158Smillertthreads->create( 46*b39c5158Smillert sub { 47*b39c5158Smillert ok(4, $test eq "foo","Test magic share fetch after thread"); 48*b39c5158Smillert $test = "baz"; 49*b39c5158Smillert ok(5,threads::shared::_refcnt($test) > $c, "Check that threadcount is correct"); 50*b39c5158Smillert })->join(); 51*b39c5158Smillertok(6,$test eq "baz","Test that value has changed in another thread"); 52*b39c5158Smillertok(7,threads::shared::_refcnt($test) == $c,"Check thrcnt is down properly"); 53*b39c5158Smillert$test = "barbar"; 54*b39c5158Smillertok(8, length($test) == 6, "Check length code"); 55*b39c5158Smillertthreads->create(sub { $test = "barbarbar" })->join; 56*b39c5158Smillertok(9, length($test) == 9, "Check length code after different thread modified it"); 57*b39c5158Smillertthreads->create(sub { undef($test)})->join(); 58*b39c5158Smillertok(10, !defined($test), "Check undef value"); 59*b39c5158Smillert 60*b39c5158Smillertok(11, is_shared($test), "Check for sharing"); 61*b39c5158Smillert 62*b39c5158Smillertexit(0); 63*b39c5158Smillert 64*b39c5158Smillert# EOF 65