ext/threads/shared/t/av_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..14\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 $sv;
  44 share($sv);
  45 $sv = "hi";
  46
  47 my @av;
  48 share(@av);
  49 push(@av, $sv);
  50
  51 ok(2, $av[0] eq "hi", 'Array holds value');
  52
  53 push(@av, "foo");
  54 ok(3, $av[1] eq 'foo', 'Array holds 2nd value');
  55
  56 my $av = threads->create(sub {
  57     my $av;
  58     my @av2;
  59     share($av);
  60     share(@av2);
  61     $av = \@av2;
  62     push(@$av, "bar", \@av);
  63     return ($av);
  64 })->join();
  65
  66 ok(4,$av->[0] eq "bar", 'Thread added to array');
  67 ok(5,$av->[1]->[0] eq 'hi', 'Shared in shared');
  68
  69 threads->create(sub { $av[0] = "hihi" })->join();
  70 ok(6,$av->[1]->[0] eq 'hihi', 'Replaced shared in shared');
  71 ok(7, pop(@{$av->[1]}) eq "foo", 'Pop shared array');
  72 ok(8, scalar(@{$av->[1]}) == 1, 'Array size');
  73
  74 threads->create(sub { @$av = () })->join();
  75 threads->create(sub { ok(9, scalar @$av == 0, 'Array cleared in thread'); })->join();
  76
  77 threads->create(sub {
  78     unshift(@$av, threads->create(sub {
  79                         my @array;
  80                         share(@array);
  81                         return (\@array);
  82                   })->join());
  83 })->join();
  84
  85 ok(10, ref($av->[0]) eq 'ARRAY', 'Array in array');
  86
  87 threads->create(sub { push @{$av->[0]}, \@av })->join();
  88 threads->create(sub { $av[0] = 'testtest'})->join();
  89 threads->create(sub { ok(11, $av->[0]->[0]->[0] eq 'testtest', 'Nested'); })->join();
  90
  91 ok(12, is_shared($sv), "Check for sharing");
  92 ok(13, is_shared(@av), "Check for sharing");
  93
  94 my $x :shared;
  95 ok(14, is_shared($x), "Check for sharing");
  96
  97 exit(0);
  98
  99 # EOF