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