ext/threads/shared/t/hv_refs.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..20\n");   ### Number of tests that will be run ###
  35 };
  36
  37 use threads;
  38 use threads::shared;
  39 ok(1, 1, 'Loaded');
  40
  41 ### Start of Testing ###
  42
  43 my $foo;
  44 share($foo);
  45 my %foo;
  46 share(%foo);
  47 $foo{"foo"} = \$foo;
  48 ok(2, !defined ${$foo{foo}}, "Check deref");
  49 $foo = "test";
  50 ok(3, ${$foo{foo}} eq "test", "Check deref after assign");
  51 threads->create(sub{${$foo{foo}} = "test2";})->join();
  52 ok(4, $foo eq "test2", "Check after assign in another thread");
  53 my $bar = delete($foo{foo});
  54 ok(5, $$bar eq "test2", "check delete");
  55 threads->create( sub {
  56    my $test;
  57    share($test);
  58    $test = "thread3";
  59    $foo{test} = \$test;
  60    })->join();
  61 ok(6, ${$foo{test}} eq "thread3", "Check reference created in another thread");
  62 my $gg = $foo{test};
  63 $$gg = "test";
  64 ok(7, ${$foo{test}} eq "test", "Check reference");
  65 my $gg2 = delete($foo{test});
  66 ok(8, threads::shared::_id($$gg) == threads::shared::_id($$gg2),
  67        sprintf("Check we get the same thing (%x vs %x)",
  68        threads::shared::_id($$gg),threads::shared::_id($$gg2)));
  69 ok(9, $$gg eq $$gg2, "And check the values are the same");
  70 ok(10, keys %foo == 0, "And make sure we realy have deleted the values");
  71 {
  72     my (%hash1, %hash2);
  73     share(%hash1);
  74     share(%hash2);
  75     $hash1{hash} = \%hash2;
  76     $hash2{"bar"} = "foo";
  77     ok(11, $hash1{hash}->{bar} eq "foo", "Check hash references work");
  78     threads->create(sub { $hash2{"bar2"} = "foo2"})->join();
  79     ok(12, $hash1{hash}->{bar2} eq "foo2", "Check hash references work");
  80     threads->create(sub { my (%hash3); share(%hash3); $hash2{hash} = \%hash3; $hash3{"thread"} = "yes"})->join();
  81     ok(13, $hash1{hash}->{hash}->{thread} eq "yes", "Check hash created in another thread");
  82 }
  83
  84 {
  85     my $h = {a=>14};
  86     my $r = \$h->{a};
  87     share($r);
  88     if ($] > 5.008) {
  89         eval { lock($r); };
  90         ok(14, !$@, "lock on helems ref: $@");
  91         eval { lock($h->{a}); };
  92         ok(15, !$@, "lock on helems: $@");
  93     } else {
  94         ok(14, 1, "skipped.  < 5.8");
  95         ok(15, 1, "skipped.  < 5.8");
  96     }
  97 }
  98 {
  99     my $object : shared = &share({});
 100     threads->new(sub {
 101                      bless $object, 'test1';
 102                  })->join;
 103     ok(16, ref($object) eq 'test1', "blessing does work");
 104     my %test = (object => $object);
 105     ok(17, ref($test{object}) eq 'test1', "and some more work");
 106     bless $object, 'test2';
 107     ok(18, ref($test{object}) eq 'test2', "reblessing works!");
 108 }
 109
 110 ok(19, is_shared($foo), "Check for sharing");
 111 ok(20, is_shared(%foo), "Check for sharing");
 112
 113 # EOF