This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads::shared 1.13
[perl5.git] / ext / threads / shared / t / 0nothread.t
index 9b08343..0808277 100644 (file)
@@ -1,74 +1,88 @@
-use Test::More tests => 53;
 use strict;
+use warnings;
+
+BEGIN {
+    if ($ENV{'PERL_CORE'}){
+        chdir 't';
+        unshift @INC, '../lib';
+    }
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+}
+
+use Test::More (tests => 53);
+
+### Start of Testing ###
 
 my @array;
 my %hash;
 
 sub hash
 {
- my @val = @_;
- is(keys %hash, 0, "hash empty");
- $hash{0} = $val[0];
- is(keys %hash,1, "Assign grows hash");
- is($hash{0},$val[0],"Value correct");
- $hash{2} = $val[2];
- is(keys %hash,2, "Assign grows hash");
- is($hash{0},$val[0],"Value correct");
- is($hash{2},$val[2],"Value correct");
- $hash{1} = $val[1];
- is(keys %hash,3,"Size correct");
- my @keys = keys %hash;
- is(join(',',sort @keys),'0,1,2',"Keys correct");
- my @hval = @hash{0,1,2};
- is(join(',',@hval),join(',',@val),"Values correct");
- my $val = delete $hash{1};
- is($val,$val[1],"Delete value correct");
- is(keys %hash,2,"Size correct");
- while (my ($k,$v) = each %hash)
-  {
-   is($v,$val[$k],"each works");
-  }
- %hash = ();
- is(keys %hash,0,"Clear hash");
+    my @val = @_;
+    is(keys %hash, 0, "hash empty");
+    $hash{0} = $val[0];
+    is(keys %hash,1, "Assign grows hash");
+    is($hash{0},$val[0],"Value correct");
+    $hash{2} = $val[2];
+    is(keys %hash,2, "Assign grows hash");
+    is($hash{0},$val[0],"Value correct");
+    is($hash{2},$val[2],"Value correct");
+    $hash{1} = $val[1];
+    is(keys %hash,3,"Size correct");
+    my @keys = keys %hash;
+    is(join(',',sort @keys),'0,1,2',"Keys correct");
+    my @hval = @hash{0,1,2};
+    is(join(',',@hval),join(',',@val),"Values correct");
+    my $val = delete $hash{1};
+    is($val,$val[1],"Delete value correct");
+    is(keys %hash,2,"Size correct");
+    while (my ($k,$v) = each %hash) {
+        is($v,$val[$k],"each works");
+    }
+    %hash = ();
+    is(keys %hash,0,"Clear hash");
 }
 
 sub array
 {
- my @val = @_;
- is(@array, 0, "array empty");
- $array[0] = $val[0];
- is(@array,1, "Assign grows array");
- is($array[0],$val[0],"Value correct");
- unshift(@array,$val[2]);
- is($array[0],$val[2],"Unshift worked");
- is($array[-1],$val[0],"-ve index");
- push(@array,$val[1]);
- is($array[-1],$val[1],"Push worked");
- is(@array,3,"Size correct");
- is(shift(@array),$val[2],"Shift worked");
- is(@array,2,"Size correct");
- is(pop(@array),$val[1],"Pop worked");
- is(@array,1,"Size correct");
- @array = ();
- is(@array,0,"Clear array");
   my @val = @_;
   is(@array, 0, "array empty");
   $array[0] = $val[0];
   is(@array,1, "Assign grows array");
   is($array[0],$val[0],"Value correct");
   unshift(@array,$val[2]);
   is($array[0],$val[2],"Unshift worked");
   is($array[-1],$val[0],"-ve index");
   push(@array,$val[1]);
   is($array[-1],$val[1],"Push worked");
   is(@array,3,"Size correct");
   is(shift(@array),$val[2],"Shift worked");
   is(@array,2,"Size correct");
   is(pop(@array),$val[1],"Pop worked");
   is(@array,1,"Size correct");
   @array = ();
   is(@array,0,"Clear array");
 }
 
 ok((require threads::shared),"Require module");
 
-array(24,[],'Thing');
-hash(24,[],'Thing');
+if ($threads::shared::VERSION && ! exists($ENV{'PERL_CORE'})) {
+    diag('Testing threads::shared ' . $threads::shared::VERSION);
+}
 
-import threads::shared;
-share(\@array);
+array(24, [], 'Thing');
+hash(24, [], 'Thing');
 
-#SKIP:
-# {
-#  skip("Wibble",1);
-#  ok(0,"No it isn't");
-# }
+threads::shared->import();
 
-array(24,42,'Thing');
+share(\@array);
+array(24, 42, 'Thing');
 
 share(\%hash);
-hash(24,42,'Thing');
+hash(24, 42, 'Thing');
 
+# EOF