ext/threads-shared/t/av_refs.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13
  14 sub ok {
  15     my ($id, $ok, $name) = @_;
  16
  17     # You have to do it this way or VMS will get confused.
  18     if ($ok) {
  19         print("ok $id - $name\n");
  20     } else {
  21         print("not ok $id - $name\n");
  22         printf("# Failed test at line %d\n", (caller)[2]);
  23     }
  24
  25     return ($ok);
  26 }
  27
  28 BEGIN {
  29     $| = 1;
  30     print("1..14\n");   ### Number of tests that will be run ###
  31 };
  32
  33 use threads;
  34 use threads::shared;
  35 ok(1, 1, 'Loaded');
  36
  37 ### Start of Testing ###
  38
  39 my $sv;
  40 share($sv);
  41 $sv = "hi";
  42
  43 my @av;
  44 share(@av);
  45 push(@av, $sv);
  46
  47 ok(2, $av[0] eq "hi", 'Array holds value');
  48
  49 push(@av, "foo");
  50 ok(3, $av[1] eq 'foo', 'Array holds 2nd value');
  51
  52 my $av = threads->create(sub {
  53     my $av;
  54     my @av2;
  55     share($av);
  56     share(@av2);
  57     $av = \@av2;
  58     push(@$av, "bar", \@av);
  59     return ($av);
  60 })->join();
  61
  62 ok(4,$av->[0] eq "bar", 'Thread added to array');
  63 ok(5,$av->[1]->[0] eq 'hi', 'Shared in shared');
  64
  65 threads->create(sub { $av[0] = "hihi" })->join();
  66 ok(6,$av->[1]->[0] eq 'hihi', 'Replaced shared in shared');
  67 ok(7, pop(@{$av->[1]}) eq "foo", 'Pop shared array');
  68 ok(8, scalar(@{$av->[1]}) == 1, 'Array size');
  69
  70 threads->create(sub { @$av = () })->join();
  71 threads->create(sub { ok(9, scalar @$av == 0, 'Array cleared in thread'); })->join();
  72
  73 threads->create(sub {
  74     unshift(@$av, threads->create(sub {
  75                         my @array;
  76                         share(@array);
  77                         return (\@array);
  78                   })->join());
  79 })->join();
  80
  81 ok(10, ref($av->[0]) eq 'ARRAY', 'Array in array');
  82
  83 threads->create(sub { push @{$av->[0]}, \@av })->join();
  84 threads->create(sub { $av[0] = 'testtest'})->join();
  85 threads->create(sub { ok(11, $av->[0]->[0]->[0] eq 'testtest', 'Nested'); })->join();
  86
  87 ok(12, is_shared($sv), "Check for sharing");
  88 ok(13, is_shared(@av), "Check for sharing");
  89
  90 my $x :shared;
  91 ok(14, is_shared($x), "Check for sharing");
  92
  93 exit(0);
  94
  95 # EOF