ext/threads/shared/t/0nothread.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     if ($ENV{'PERL_CORE'}){
   6         chdir 't';
   7         unshift @INC, '../lib';
   8     }
   9 }
  10
  11 use Test::More (tests => 53);
  12
  13 ### Start of Testing ###
  14
  15 my @array;
  16 my %hash;
  17
  18 sub hash
  19 {
  20     my @val = @_;
  21     is(keys %hash, 0, "hash empty");
  22     $hash{0} = $val[0];
  23     is(keys %hash,1, "Assign grows hash");
  24     is($hash{0},$val[0],"Value correct");
  25     $hash{2} = $val[2];
  26     is(keys %hash,2, "Assign grows hash");
  27     is($hash{0},$val[0],"Value correct");
  28     is($hash{2},$val[2],"Value correct");
  29     $hash{1} = $val[1];
  30     is(keys %hash,3,"Size correct");
  31     my @keys = keys %hash;
  32     is(join(',',sort @keys),'0,1,2',"Keys correct");
  33     my @hval = @hash{0,1,2};
  34     is(join(',',@hval),join(',',@val),"Values correct");
  35     my $val = delete $hash{1};
  36     is($val,$val[1],"Delete value correct");
  37     is(keys %hash,2,"Size correct");
  38     while (my ($k,$v) = each %hash) {
  39         is($v,$val[$k],"each works");
  40     }
  41     %hash = ();
  42     is(keys %hash,0,"Clear hash");
  43 }
  44
  45 sub array
  46 {
  47     my @val = @_;
  48     is(@array, 0, "array empty");
  49     $array[0] = $val[0];
  50     is(@array,1, "Assign grows array");
  51     is($array[0],$val[0],"Value correct");
  52     unshift(@array,$val[2]);
  53     is($array[0],$val[2],"Unshift worked");
  54     is($array[-1],$val[0],"-ve index");
  55     push(@array,$val[1]);
  56     is($array[-1],$val[1],"Push worked");
  57     is(@array,3,"Size correct");
  58     is(shift(@array),$val[2],"Shift worked");
  59     is(@array,2,"Size correct");
  60     is(pop(@array),$val[1],"Pop worked");
  61     is(@array,1,"Size correct");
  62     @array = ();
  63     is(@array,0,"Clear array");
  64 }
  65
  66 ok((require threads::shared),"Require module");
  67
  68 if ($threads::shared::VERSION && ! exists($ENV{'PERL_CORE'})) {
  69     diag('Testing threads::shared ' . $threads::shared::VERSION);
  70 }
  71
  72 array(24, [], 'Thing');
  73 hash(24, [], 'Thing');
  74
  75 threads::shared->import();
  76
  77 share(\@array);
  78 array(24, 42, 'Thing');
  79
  80 share(\%hash);
  81 hash(24, 42, 'Thing');
  82
  83 exit(0);
  84
  85 # EOF