ext/threads/shared/t/hv_refs.t

   1 use warnings;
   2
   3 BEGIN {
   4 #    chdir 't' if -d 't';
   5 #    push @INC ,'../lib';
   6     require Config; import Config;
   7     unless ($Config{'useithreads'}) {
   8         print "1..0 # Skip: no useithreads\n";
   9         exit 0;
  10     }
  11 }
  12
  13
  14 sub ok {
  15     my ($id, $ok, $name) = @_;
  16
  17     $name = '' unless defined $name;
  18     # You have to do it this way or VMS will get confused.
  19     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
  20
  21     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  22
  23     return $ok;
  24 }
  25
  26 sub skip {
  27     my ($id, $ok, $name) = @_;
  28     print "ok $id # skip _thrcnt - $name \n";
  29 }
  30
  31 use ExtUtils::testlib;
  32 use strict;
  33 BEGIN { print "1..17\n" };
  34 use threads;
  35 use threads::shared;
  36 ok(1,1,"loaded");
  37 my $foo;
  38 share($foo);
  39 my %foo;
  40 share(%foo);
  41 $foo{"foo"} = \$foo;
  42 ok(2, !defined ${$foo{foo}}, "Check deref");
  43 $foo = "test";
  44 ok(3, ${$foo{foo}} eq "test", "Check deref after assign");
  45 threads->create(sub{${$foo{foo}} = "test2";})->join();
  46 ok(4, $foo eq "test2", "Check after assign in another thread");
  47 my $bar = delete($foo{foo});
  48 ok(5, $$bar eq "test2", "check delete");
  49 threads->create( sub {
  50    my $test;
  51    share($test);
  52    $test = "thread3";
  53    $foo{test} = \$test;
  54    })->join();
  55 ok(6, ${$foo{test}} eq "thread3", "Check reference created in another thread");
  56 my $gg = $foo{test};
  57 $$gg = "test";
  58 ok(7, ${$foo{test}} eq "test", "Check reference");
  59 my $gg2 = delete($foo{test});
  60 ok(8, threads::shared::_id($$gg) == threads::shared::_id($$gg2),
  61        sprintf("Check we get the same thing (%x vs %x)",
  62        threads::shared::_id($$gg),threads::shared::_id($$gg2)));
  63 ok(9, $$gg eq $$gg2, "And check the values are the same");
  64 ok(10, keys %foo == 0, "And make sure we realy have deleted the values");
  65 {
  66     my (%hash1, %hash2);
  67     share(%hash1);
  68     share(%hash2);
  69     $hash1{hash} = \%hash2;
  70     $hash2{"bar"} = "foo";
  71     ok(11, $hash1{hash}->{bar} eq "foo", "Check hash references work");
  72     threads->create(sub { $hash2{"bar2"} = "foo2"})->join();
  73     ok(12, $hash1{hash}->{bar2} eq "foo2", "Check hash references work");
  74     threads->create(sub { my (%hash3); share(%hash3); $hash2{hash} = \%hash3; $hash3{"thread"} = "yes"})->join();
  75     ok(13, $hash1{hash}->{hash}->{thread} eq "yes", "Check hash created in another thread");
  76 }
  77
  78 {
  79   my $h = {a=>14};
  80   my $r = \$h->{a};
  81   share($r);
  82   lock($r);
  83   lock($h->{a});
  84   ok(14, 1, "lock on helems now work, this was bug 10045");
  85
  86 }
  87 {
  88     my $object : shared = &share({});
  89     threads->new(sub {
  90                      bless $object, 'test1';
  91                  })->join;
  92     ok(15, ref($object) eq 'test1', "blessing does work");
  93     my %test = (object => $object);
  94     ok(16, ref($test{object}) eq 'test1', "and some more work");
  95     bless $object, 'test2';
  96     ok(17, ref($test{object}) eq 'test2', "reblessing works!");
  97 }
  98