ext/threads/shared/t/no_share.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     if ($ENV{'PERL_CORE'}){
   6         chdir 't';
   7         unshift @INC, '../lib';
   8     }
   9     use Config;
  10     if (! $Config{'useithreads'}) {
  11         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
  12         exit(0);
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 sub ok {
  19     my ($id, $ok, $name) = @_;
  20
  21     # You have to do it this way or VMS will get confused.
  22     if ($ok) {
  23         print("ok $id - $name\n");
  24     } else {
  25         print("not ok $id - $name\n");
  26         printf("# Failed test at line %d\n", (caller)[2]);
  27     }
  28
  29     return ($ok);
  30 }
  31
  32 BEGIN {
  33     $| = 1;
  34     print("1..6\n");   ### Number of tests that will be run ###
  35 };
  36
  37 our $warnmsg;
  38 BEGIN {
  39     $SIG{__WARN__} = sub { $warnmsg = shift; };
  40 }
  41
  42 use threads::shared;
  43 use threads;
  44 ok(1, 1, 'Loaded');
  45
  46 ### Start of Testing ###
  47
  48 ok(2, ($warnmsg =~ /Warning, threads::shared has already been loaded/)?1:0,
  49     "threads has warned us");
  50
  51 my $test = "bar";
  52 share($test);
  53 ok(3, $test eq "bar", "Test disabled share not interfering");
  54
  55 threads->create(sub {
  56                    ok(4, $test eq "bar", "Test disabled share after thread");
  57                    $test = "baz";
  58                 })->join();
  59 # Value should either remain unchanged or be value set by other thread
  60 ok(5, $test eq "bar" || $test eq 'baz', "Test that value is an expected one");
  61
  62 ok(6, ! is_shared($test), "Check for sharing");
  63
  64 exit(0);
  65
  66 # EOF