ext/Thread-Queue/t/05_extract.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 threads;
  17 use Thread::Queue;
  18
  19 if ($] == 5.008) {
  20     require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
  21 } else {
  22     require Test::More;
  23 }
  24 Test::More->import();
  25 plan('tests' => 20);
  26
  27 my $q = Thread::Queue->new(1..10);
  28 ok($q, 'New queue');
  29
  30 threads->create(sub {
  31     # Default count = 1
  32     is($q->extract(),   1, 'No args');          # 2..10 left
  33     is($q->extract(0),  2, 'Head');             # 3..10 left
  34     is($q->extract(5),  8, 'Pos index');        # 3..7,9,10 left
  35     is($q->extract(-3), 7, 'Neg index');        # 3..6,9,10 left
  36     my $x = $q->extract(20);                    # unchanged
  37     ok(! defined($x), 'Big index');
  38     $x = $q->extract(-20);                      # unchanged
  39     ok(! defined($x), 'Big neg index');
  40 })->join();
  41
  42 $q = Thread::Queue->new(1..10);
  43 ok($q, 'New queue');
  44
  45 threads->create(sub {
  46     my @x = $q->extract(0, 2);                  # 3..10 left
  47     is_deeply(\@x, [1,2], '2 from head');
  48     @x = $q->extract(6, 2);                     # 3..8 left
  49     is_deeply(\@x, [9,10], '2 from tail');
  50     @x = $q->extract(2, 2);                     # 3,4,7,8 left
  51     is_deeply(\@x, [5,6], '2 from middle');
  52     @x = $q->extract(2, 4);                     # 3,4 left
  53     is_deeply(\@x, [7,8], 'Lots from tail');
  54     @x = $q->extract(3, 4);                     # unchanged
  55     is_deeply(\@x, [], 'Too far');
  56 })->join();
  57
  58 $q = Thread::Queue->new(1..10);
  59 ok($q, 'New queue');
  60
  61 threads->create(sub {
  62     my @x = $q->extract(-4, 2);                 # 1..6,9,10 left
  63     is_deeply(\@x, [7,8], 'Neg index');
  64     @x = $q->extract(-2, 4);                    # 1..6 left
  65     is_deeply(\@x, [9,10], 'Lots from tail');
  66     @x = $q->extract(-6, 2);                    # 3..6 left
  67     is_deeply(\@x, [1,2], 'Max neg index');
  68     @x = $q->extract(-10, 3);                   # unchanged
  69     is_deeply(\@x, [], 'Too far');
  70     @x = $q->extract(-6, 3);                    # 4..6 left
  71     is_deeply(\@x, [3], 'Neg overlap');
  72     @x = $q->extract(-5, 10);                   # empty
  73     is_deeply(\@x, [4..6], 'Neg big overlap');
  74 })->join();
  75
  76 exit(0);
  77
  78 # EOF