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..6\n"); ### Number of tests that will be run ### 31*b39c5158Smillert}; 32*b39c5158Smillert 33*b39c5158Smillertour $warnmsg; 34*b39c5158SmillertBEGIN { 35*b39c5158Smillert $SIG{__WARN__} = sub { $warnmsg = shift; }; 36*b39c5158Smillert} 37*b39c5158Smillert 38*b39c5158Smillertuse threads::shared; 39*b39c5158Smillertuse threads; 40*b39c5158Smillertok(1, 1, 'Loaded'); 41*b39c5158Smillert 42*b39c5158Smillert### Start of Testing ### 43*b39c5158Smillert 44*b39c5158Smillertok(2, ($warnmsg =~ /Warning, threads::shared has already been loaded/)?1:0, 45*b39c5158Smillert "threads has warned us"); 46*b39c5158Smillert 47*b39c5158Smillertmy $test = "bar"; 48*b39c5158Smillertshare($test); 49*b39c5158Smillertok(3, $test eq "bar", "Test disabled share not interfering"); 50*b39c5158Smillert 51*b39c5158Smillertthreads->create(sub { 52*b39c5158Smillert ok(4, $test eq "bar", "Test disabled share after thread"); 53*b39c5158Smillert $test = "baz"; 54*b39c5158Smillert })->join(); 55*b39c5158Smillert# Value should either remain unchanged or be value set by other thread 56*b39c5158Smillertok(5, $test eq "bar" || $test eq 'baz', "Test that value is an expected one"); 57*b39c5158Smillert 58*b39c5158Smillertok(6, ! is_shared($test), "Check for sharing"); 59*b39c5158Smillert 60*b39c5158Smillertexit(0); 61*b39c5158Smillert 62*b39c5158Smillert# EOF 63