ext/threads/shared/t/clone.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..28\n");   ### Number of tests that will be run ###
  35 };
  36
  37 my $test = 1;
  38
  39 use threads;
  40 use threads::shared;
  41 ok($test++, 1, 'Loaded');
  42
  43 ### Start of Testing ###
  44
  45 {
  46     # Scalar
  47     my $x = shared_clone(14);
  48     ok($test++, $x == 14, 'number');
  49
  50     $x = shared_clone('test');
  51     ok($test++, $x eq 'test', 'string');
  52 }
  53
  54 {
  55     my %hsh = ('foo' => 2);
  56     eval {
  57         my $x = shared_clone(%hsh);
  58     };
  59     ok($test++, $@ =~ /Usage:/, '1 arg');
  60
  61     threads->create(sub {})->join();  # Hide leaks, etc.
  62 }
  63
  64 {
  65     my $x = 'test';
  66     my $foo :shared = shared_clone($x);
  67     ok($test++, $foo eq 'test', 'cloned string');
  68
  69     $foo = shared_clone(\$x);
  70     ok($test++, $$foo eq 'test', 'cloned scalar ref');
  71
  72     threads->create(sub {
  73         ok($test++, $$foo eq 'test', 'cloned scalar ref in thread');
  74     })->join();
  75
  76     $test++;
  77 }
  78
  79 {
  80     my $foo :shared;
  81     $foo = shared_clone(\$foo);
  82     ok($test++, ref($foo) eq 'REF', 'Circular ref typ');
  83     ok($test++, threads::shared::_id($foo) == threads::shared::_id($$foo), 'Circular ref');
  84
  85     threads->create(sub {
  86         ok($test++, threads::shared::_id($foo) == threads::shared::_id($$foo), 'Circular ref in thread');
  87
  88         my ($x, $y, $z);
  89         $x = \$y; $y = \$z; $z = \$x;
  90         $foo = shared_clone($x);
  91     })->join();
  92
  93     $test++;
  94
  95     ok($test++, threads::shared::_id($$foo) == threads::shared::_id($$$$$foo),
  96                     'Cloned circular refs from thread');
  97 }
  98
  99 {
 100     my @ary = (qw/foo bar baz/);
 101     my $ary = shared_clone(\@ary);
 102
 103     ok($test++, $ary->[1] eq 'bar', 'Cloned array');
 104     $ary->[1] = 99;
 105     ok($test++, $ary->[1] == 99, 'Clone mod');
 106     ok($test++, $ary[1] eq 'bar', 'Original array');
 107
 108     threads->create(sub {
 109         ok($test++, $ary->[1] == 99, 'Clone mod in thread');
 110
 111         $ary[1] = 'bork';
 112         $ary->[1] = 'thread';
 113     })->join();
 114
 115     $test++;
 116
 117     ok($test++, $ary->[1] eq 'thread', 'Clone mod from thread');
 118     ok($test++, $ary[1] eq 'bar', 'Original array');
 119 }
 120
 121 {
 122     my $scalar = 'zip';
 123
 124     my $obj = {
 125         'ary' => [ 1, 'foo', [ 86 ], { 'bar' => [ 'baz' ] } ],
 126         'ref' => \$scalar,
 127     };
 128
 129     $obj->{'self'} = $obj;
 130
 131     bless($obj, 'Foo');
 132
 133     my $copy :shared;
 134
 135     threads->create(sub {
 136         $copy = shared_clone($obj);
 137
 138         ok($test++, ${$copy->{'ref'}} eq 'zip', 'Obj ref in thread');
 139         ok($test++, threads::shared::_id($copy) == threads::shared::_id($copy->{'self'}), 'Circular ref in cloned obj');
 140         ok($test++, is_shared($copy->{'ary'}->[2]), 'Shared element in cloned obj');
 141     })->join();
 142
 143     $test += 3;
 144
 145     ok($test++, ref($copy) eq 'Foo', 'Obj cloned by thread');
 146     ok($test++, ${$copy->{'ref'}} eq 'zip', 'Obj ref in thread');
 147     ok($test++, threads::shared::_id($copy) == threads::shared::_id($copy->{'self'}), 'Circular ref in cloned obj');
 148     ok($test++, $copy->{'ary'}->[3]->{'bar'}->[0] eq 'baz', 'Deeply cloned');
 149     ok($test++, ref($copy) eq 'Foo', 'Cloned object class');
 150 }
 151
 152 {
 153     my $hsh :shared = shared_clone({'foo' => [qw/foo bar baz/]});
 154     ok($test++, is_shared($hsh), 'Shared hash ref');
 155     ok($test++, is_shared($hsh->{'foo'}), 'Shared hash ref elem');
 156     ok($test++, $$hsh{'foo'}[1] eq 'bar', 'Cloned structure');
 157 }
 158
 159 exit(0);
 160
 161 # EOF