Firstly, as I already said. Thank you for stepping up. I note that the 'big guns' have ducked & covered, presumably keeping their power dry.

I've spent the best part of yesterday responding to your test suite section by section, and I just discarded most of it because it would be seen as picking on you, rather than targeting the tools I am so critical off.

1. # Test that Q.pm actually compiles.

   BEGIN { use_ok 'Q' };
   [download]

   What is the purpose of this test?

   • What happens if the test is included and the Q module is not loadable?

     The Test::* modules trap the fatal error from Perl, and so the test suite continues to run, failing every test.

     Not useful.

   • What happens if we do a simple use Module; instead.

     We get two lines of output instead of 6. The lines aren't preceded by comment cards so my editor does not ignore them. The test stops immediately rather than running on testing stuff that cannot possibly pass; or is in error if it does.

     Useful.

   • What is actually being tested here?

     That perl can load a module? If it couldn't the Test::* tools wouldn't load.

     Not useful.

     That the tarball unpacked correctly? Perl would tell me that just as reliably.

     No more useful than Perl.

     That the module installed correctly? No. Because when the test suite is run, the module isn't installed. It is still in the blib structure.

     Not useful.

   • And why does it force me to put it in a BEGIN{}? Because without it, I'd have to use parens on all my method calls otherwise they may be taken as filehandles or barewords.

     Worse than non-useful. Detrimental. Extra work because of changed behaviour.

2. # new_ok

   my $q = new_ok Q => [5];
   [download]

   This apparently tests whether the return object is of the same class as the name supplied for the class. Why?

   That prevents me from doing:

   package Thing;
   use if $^O eq 'MSWin32' ? 'Thing::Win32' : 'Thing::nix';
   
   sub new { $^O eq 'MSWin32' ) ? &Thing::Win32->new() : &Thing::nix->new
   +(); }
   [download]

   Detrimental. Extra work; limits options.

3. # Test that the API as documented still exists.

   can_ok $q => 'nq';
   can_ok $q => 'dq';
   can_ok $q => 'n';
   [download]

   • What do get if we use this and it fails?

     not ok 1 - async::Q->can('pq')
     #   Failed test 'async::Q->can('pq')'
     #   at -e line 1.
     #     async::Q->can('pq') failed
     [download]

     Four lines, three of which just repeat the same thing in different words. And the tests continue despite that any that use that method will fail.

     No benefit. verbose. Repetitive.

   • And if we let Perl detect it?

     Can't locate object method "pq" via package "async::Q" at -e line 1.
     [download]

     One line, no comment card. No repetition.

   Pointless extra work for no benefit.

4. The rest elided.

Again, thank you for being a willing subject. Now's your chance for revenge :) Take it!

Here is my module complete with its test suite:

#! perl -slw
use strict;
package async::Q;
use async::Util;
use threads;
use threads::shared;
use constant {
    NEXT_WRITE  => -2,
    N           => -1,
};

sub new { # twarn "new: @_\n";
    my( $class, $Qsize ) = @_;
    $Qsize //= 3;
    my @Q :shared;
    $#Q = $Qsize;
    @Q[ NEXT_WRITE, N ] = ( 0, 0 );
    return bless \@Q, $class;
}

sub nq { # twarn "nq: @_\n";
    my $self = shift;
    lock @$self;
    for( @_ ) {
        cond_wait @$self until $self->[ N ] < ( @$self-2 );
        $self->[ $self->[ NEXT_WRITE ]++ ] = $_;
        ++$self->[ N ];
        $self->[ NEXT_WRITE ] %= ( @$self - 2 );
        cond_signal @$self;
    }
}

sub dq { # twarn "dq: @_\n";
    my $self = shift;
    lock @$self;
    cond_wait @$self until $self->[ N ] > 0;
    my $p = $self->[ NEXT_WRITE ] - $self->[ N ]--;
    $p += @$self -2 if $p < 0;
    my $out =  $self->[ $p ];
    cond_signal @$self;
    return $out;
}

sub n { # twarn "n: @_\n";
    my $self = shift;
    lock @$self;
    return $self->[ N ];
}

sub _state { # twarn "_state: @_\n";
    no warnings;
    my $self = shift;
    lock @$self;
    return join '|', @{ $self };
}

return 1 if caller;

package main;
use strict;
use warnings;
use threads ( stack_size => 4096 );
use threads::shared;
use async::Util;
use Time::HiRes qw[ time sleep ];

our $SIZE //= 10;
our $N    //= 1e5;
our $T    //= 4; ++$T; $T &= ~1;

my $Q1_n  = new async::Q( $SIZE );
my $Qn_n  = new async::Q( $SIZE );
my $Qn_1  = new async::Q( $SIZE );

my @t1 = map async( sub{ $Qn_n->nq( $_ ) while defined( $_ = $Q1_n->dq
+ ); } ), 1 .. $T/2;
my @t2 = map async( sub{ $Qn_1->nq( $_ ) while defined( $_ = $Qn_n->dq
+ ); } ), 1 .. $T/2;

my $bits :shared = chr(0); $bits x= $N/ 8 + 1;
my $t = async{
    while( defined( $_ = $Qn_1->dq ) ) {
        die "value duplicated" if vec( $bits, $_, 1 );
        vec( $bits, $_, 1 ) = 1;
    }
};

my $start = time;

$Q1_n->nq( $_ ) for 1 .. $N;
$Q1_n->nq( (undef) x ($T/2) ); $_->join for @t1;
$Qn_n->nq( (undef) x ($T/2) ); $_->join for @t2;
$Qn_1->nq( undef );            $_->join for $t;

my $stop = time;

my $b = unpack '%32b*', $bits;
die "NOK: $b : \n" . $Q1_n->_state, $/, $Qn_n->_state, $/, $Qn_1->_sta
+te unless $b == $N;

printf "$N items by $T threads via three Qs size $SIZE in %.6f seconds
+\n",
    $stop - $start;
__END__
C:\test>perl async\Q.pm -N=1e4 -T=2 -SIZE=40
1e4 items by 2 threads via three Qs size 40 in 5.768000 seconds

C:\test>perl async\Q.pm -N=1e4 -T=20 -SIZE=40
1e4 items by 20 threads via three Qs size 40 in 7.550000 seconds

C:\test>perl async\Q.pm -N=1e4 -T=200 -SIZE=400
1e4 items by 200 threads via three Qs size 400 in 8.310000 seconds
[download]

You'll notice that in addition to performing a default test, it can be configured through command line parameters to vary the key parameters of the test.

The actual test consists of setting up 3 queues. One thread feeding data via the first queue to a pool of threads (1 to many). That pool dequeues the input and passes on to a second pool of threads via the second queue (many to many). And finally those threads pass the data back to the main thread via the third queue (many to 1).

The data for a run consists of a simple list of integers. Once they make it back to the main thread, they are checked off against a bitmap tally to ensure that nothing is dequeued twice, nor omitted.

All in one file; no extraneous modules; no extraneous output; completely compatible with any other test tools available, because it is nothing more than a simple perl script.

Feel free to rip it to shreds.