The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
#####################################################################
## AUTHOR: Mary Ehlers, regina.verbae@gmail.com
## ABSTRACT: Test the Piper::Instance module with pipes
#####################################################################

use v5.10;
use strict;
use warnings;

use Test::Most;
use Test::Memory::Cycle;

my $APP = "Piper::Instance";

use Piper;

#####################################################################

# Test descendant/find_segment
{
    my $MAIN = Piper->new(
        child_pipe => Piper->new(
            grand_pipe => Piper->new(
                great_proc => sub {},
            ),
            grand_proc => sub {},
        ),
        child_proc => sub {},
        { label => 'main' },
    )->init;

    my ($CHILD_PIPE, $CHILD_PROC) = @{$MAIN->children};
    my ($GRAND_PIPE, $GRAND_PROC) = @{$CHILD_PIPE->children};
    my $GREAT_PROC = $GRAND_PIPE->children->[0];

    my $A = Piper->new(
        B => Piper->new(
            A => Piper->new(
                B => sub {},
            ),
            B => sub {},
        ),
        C => sub {},
        { label => 'A' },
    )->init;

    my ($AB, $AC) = @{$A->children};
    my ($ABA, $ABB) = @{$AB->children};
    my $ABAB = $ABA->children->[0];

    subtest "$APP - descendant" => sub {
        my $ALL = [ $MAIN, $CHILD_PIPE, $GRAND_PIPE ];
        my %EXP = (
            'main' => [
                { search => [ 'main' ], from => [ $MAIN ],
                    undef => [ $CHILD_PIPE, $GRAND_PIPE ] },
            ],
            'main/child_pipe' => [
                { search => [ 'child_pipe' ], from => [ $MAIN, $CHILD_PIPE ],
                    undef => [ $GRAND_PIPE ] },
                { search => [ 'main/child_pipe' ], from => [ $MAIN ],
                    undef => [ $CHILD_PIPE, $GRAND_PIPE ] },
            ],
            'main/child_proc' => [
                { search => [ 'child_proc', 'main/child_proc' ], from => [ $MAIN ],
                    undef => [ $CHILD_PIPE, $GRAND_PIPE ] },
            ],
            'main/child_pipe/grand_pipe' => [
                { search => [ 'grand_pipe' ], from => $ALL, undef => [] },
                { search => [ 'child_pipe/grand_pipe' ], from => [ $MAIN, $CHILD_PIPE ],
                    undef => [ $GRAND_PIPE ] },
            ],
            'main/child_pipe/grand_proc' => [
                { search => [ 'grand_proc', 'child_pipe/grand_proc' ],
                    from => [ $MAIN, $CHILD_PIPE ], undef => [ $GRAND_PIPE ] },
                { search => [ 'main/child_pipe/grand_proc' ], from => [ $MAIN ],
                    undef => [ $CHILD_PIPE, $GRAND_PIPE ] },
            ],
            'main/child_pipe/grand_pipe/great_proc' => [
                { search => [ 'great_proc' ], from => $ALL, undef => [] },
                { search => [ 'grand_pipe/great_proc' ], from => $ALL, undef => [] },
                { search => [ 'child_pipe/grand_pipe/great_proc' ],
                    from => [ $MAIN, $CHILD_PIPE ], undef => [ $GRAND_PIPE ] },
                { search => [ 'main/child_pipe/grand_pipe/great_proc' ],
                    from => [ $MAIN ], undef => [ $CHILD_PIPE, $GRAND_PIPE ] },
            ],
        );

        for my $exp (keys %EXP) {
            for my $set (@{$EXP{$exp}}) {
                for my $loc (@{$set->{search}}) {
                    for my $FROM (@{$set->{from}}) {
                        is(
                            $FROM->descendant($loc),
                            $exp,
                            "Found $loc ($exp) descended from ".$FROM->label
                        );
                    }

                    for my $UNDEF (@{$set->{undef}}) {
                        is(
                            $UNDEF->descendant($loc),
                            undef,
                            "Could not find $loc ($exp) descended from ".$UNDEF->label
                        );
                    }
                }
            }
        }

        is($A->descendant('A'), 'A/B/A', 'search grandchildren before self');
        is($A->descendant('A/B'), 'A/B/A/B', 'search deeply before self');
        is($AB->descendant('B'), 'A/B/B', 'search children before self');

        # This wouldn't happen in find_segment, but it tests the referrer logic
        is($A->descendant('A/B', $AB), 'A/B', 'referrer blocks appropriate search');

        is($AB->descendant('B/B'), 'A/B/B', 'find double-name');

        my %UNDEF = (
            bad_name => [ $MAIN, $CHILD_PIPE, $GRAND_PIPE ],
            main => [ $CHILD_PIPE, $GRAND_PIPE ],
            'main/bad_name' => [ $MAIN, $CHILD_PIPE, $GRAND_PIPE ],
            'bad_name/main/child_pipe' => [ $MAIN, $CHILD_PIPE ],
        );

        for my $undef (keys %UNDEF) {
            for my $FROM (@{$UNDEF{$undef}}) {
                is($FROM->descendant($undef), undef, "$undef not found from ".$FROM->label);
            }
        }
    };

    subtest "$APP - find_segment" => sub {
        my $ALL = [ $MAIN, $CHILD_PIPE, $CHILD_PROC, $GRAND_PIPE, $GRAND_PROC, $GREAT_PROC ];
        my @EXP = qw(
            main
            main/child_pipe
            main/child_proc
            main/child_pipe/grand_pipe
            main/child_pipe/grand_proc
            main/child_pipe/grand_pipe/great_proc
        );

        for my $exp (@EXP) {
            for my $FROM (@$ALL) {
                my @parts = split('/', $exp);
                while (@parts) {
                    my $loc = join('/', @parts);
                    is($FROM->find_segment($loc), $exp, "Found '$loc' from ".$FROM->label);
                    shift @parts;
                }
            }
        }

        $ALL = [ $A, $AB, $AC, $ABA, $ABB, $ABAB ];
        my %EXP = (
            A => [
                { search => [ 'A' ], from => [], fail => $ALL }
            ],
            'A/B' => [
                { search => [ 'B' ], from => [ $A, $AC ], fail => [ $AB, $ABA, $ABB, $ABAB ] },
                { search => [ 'A/B' ], from => [], fail => $ALL },
            ],
            'A/C' => [
                { search => [ 'C', 'A/C' ], from => $ALL, fail => [] },
            ],
            'A/B/A' => [
                { search => [ 'A', 'B/A', 'A/B/A' ], from => $ALL, fail => [] },
            ],
            'A/B/B' => [
                { search => [ 'B' ], from => [ $AB, $ABB ], fail => [ $A, $AC, $ABA, $ABAB ] },
                { search => [ 'B/B', 'A/B/B' ], from => $ALL, fail => [] }, 
            ],
            'A/B/A/B' => [
                { search => [ 'B' ], from => [ $ABA, $ABAB ], fail => [ $A, $AB, $AC, $ABB ] },
                { search => [ 'A/B', 'B/A/B', 'A/B/A/B' ], from => $ALL, fail => [] },
            ],
        );

        for my $exp (keys %EXP) {
            for my $set (@{$EXP{$exp}}) {
                for my $loc (@{$set->{search}}) {
                    for my $FROM (@{$set->{from}}) {
                        is(
                            $FROM->find_segment($loc),
                            $exp,
                            "Found '$loc' ($exp) from ".$FROM->path
                        );
                    }

                    for my $FAIL (@{$set->{fail}}) {
                        isnt(
                            $FAIL->find_segment($loc),
                            $exp,
                            "Did not find '$loc' ($exp) from ".$FAIL->path
                        );
                    }
                }
            }
        }
    };
}

#####################################################################

# Test small case first
{
    subtest "$APP - one child only" => sub {
        my $SMALL = Piper->new(
            half => {
                batch_size => 2,
                allow => sub { $_ % 2 == 0 },
                handler => sub {
                    my ($instance, $batch) = @_;
                    $instance->emit(map { int( $_ / 2 ) } @$batch);
                },
            },
            {
                label => 'main',
                batch_size => 4,
            }
        )->init();

        my $CHILD = $SMALL->children->[0];

        # Test path
        subtest "$APP - path" => sub {
            is($SMALL->path, 'main', 'pipe ok');
            is($CHILD->path, 'main/half', 'child ok');
        };

        # Test parentage
        subtest "$APP - parentage" => sub {
            ok(!$SMALL->has_parent, 'no parent for pipe');
            ok($CHILD->has_parent, 'child has parent');
            is($CHILD->parent->path, 'main', 'parent is pipe');
        };

        # Test debug/verbose
        for my $type (qw(debug verbose)) {
            my $has = "has_$type";
            my $clear = "clear_$type";
            subtest "$APP - $type" => sub {
                ok(!$SMALL->$has(), 'predicate');
                ok(!$CHILD->$has(), 'child predicate');
                is($SMALL->$type(), 0, 'default');
                is($CHILD->$type(), 0, 'child default');

                $SMALL->$type(1);
                ok($SMALL->$has(), 'predicate after set');
                ok(!$CHILD->$has(), 'child predicate not affected');
                is($SMALL->$type(), 1, 'writer ok');
                is($CHILD->$type(), 1, 'child inherits parent');

                $CHILD->$type(2);
                ok($CHILD->$has(), 'child predicate after set');
                is($SMALL->$type(), 1, 'parent not affected by child');
                is($CHILD->$type(), 2, 'child no longer inherits');

                $CHILD->$clear();
                ok(!$CHILD->$has(), 'child clearer ok');
                is($SMALL->$type(), 1, 'parent unaffected by child clearer');
                is($CHILD->$type(), 1, 'child inherits again');

                $SMALL->$clear();
                ok(!$SMALL->$has(), 'parent clearer ok');
            };
        }

        # Test batch_size
        subtest "$APP - batch_size" => sub {
            is($SMALL->batch_size, 4, 'pipe ok');
            is($CHILD->batch_size, 2, 'child overrides pipe');
        };

        # Test queueing
        subtest "$APP - queueing" => sub {
            ok(!$SMALL->pending, 'not yet pending');
            ok(!$SMALL->ready, 'not yet ready');
            is($SMALL->pressure, 0, 'no pressure');

            my @data = (1..3);
            $SMALL->enqueue(map { $_ * 2 } @data);

            is($SMALL->pending, 3, 'pending items');
            ok(!$SMALL->ready, 'still no ready');
            is($SMALL->pressure, 150, 'positive pressure');
        };

        # Test process_batch
        subtest "$APP - process_batch" => sub {
            $SMALL->process_batch;

            is($SMALL->pending, 1, 'removed from pending queue');
            is($SMALL->ready, 2, 'items processed successfully');

            $SMALL->process_batch;

            is($SMALL->pending, 0, 'removed un-full batch from pending queue');
            is($SMALL->ready, 3, 'un-full batch processed successfully');
        };

        # Test dequeue
        subtest "$APP - dequeue" => sub {
            is_deeply(
                [ $SMALL->dequeue(2) ],
                [ 1..2 ],
                'dequeue multiple'
            );

            is($SMALL->dequeue, 3, 'dequeue single');

            is_deeply(
                [ $SMALL->dequeue(2) ],
                [],
                'dequeue empty'
            );
        };

        # Test exhaustion
        subtest "$APP - exhaustion" => sub {
            ok($SMALL->is_exhausted, 'empty - is_exhausted');
            ok(!$SMALL->isnt_exhausted, 'empty - isnt_exhausted');

            $SMALL->enqueue(2);

            ok(!$SMALL->is_exhausted, 'queued - is_exhausted');
            ok($SMALL->isnt_exhausted, 'queued - isnt_exhausted');

            while ($SMALL->isnt_exhausted) {
                $SMALL->dequeue;
            }

            ok($SMALL->is_exhausted, 'emptied - is_exhausted');
            ok(!$SMALL->isnt_exhausted, 'emptied - isnt_exhausted');
        };

        # Test allow
        subtest "$APP - allow" => sub {
            # Odd numbers skipped
            $SMALL->enqueue(1..5);

            is($SMALL->pending, 2, 'allowed items pending');
            is($SMALL->ready, 3, 'skipped items ready');
            is_deeply(
                [ $SMALL->dequeue(5) ],
                [ 1, 3, 5 ],
                'allow succeeded'
            );

            $SMALL->process_batch;
            is($SMALL->ready, 2, 'allowed items processed');
            is_deeply(
                [ $SMALL->dequeue(2) ],
                [ 1, 2 ],
                'allowed items processed correctly'
            );
        };

        # Test disabling
        subtest "$APP - disabling" => sub {
            $SMALL->enabled(0);
            is($SMALL->enabled, 0, 'disabled pipe');
            is($CHILD->enabled, 0, 'child inherits disable from parent');

            $SMALL->enqueue(1..3);
            is($SMALL->pending, 0, 'nothing pending in disabled pipe');
            is($SMALL->ready, 3, 'items skipped disabled pipe');

            is_deeply(
                [ $SMALL->dequeue(3) ],
                [ 1..3 ],
                'skipped items dequeued unchanged'
            );

            $SMALL->enabled(1);
            $CHILD->enabled(0);
            is($SMALL->enabled, 1, 'parent does not inherit disable from child');
            is($CHILD->enabled, 0, 'child disabled');

            $SMALL->enqueue(1..3);
            is($SMALL->pending, 0, 'nothing pending in pipe with 1 non-enabled child');
            is($SMALL->ready, 3, 'items skipped 1 non-enabled child');

            is_deeply(
                [ $SMALL->dequeue(3) ],
                [ 1..3 ],
                'skipped items dequeued unchanged'
            );

            $CHILD->enabled(1);
        };

        # Test emit
        subtest "$APP - emit" => sub {
            $CHILD->emit(4..6);
            is_deeply(
                [ $SMALL->dequeue(3) ],
                [ 4..6 ],
                'fake emit - ok'
            );

            my $EMITTER = Piper->new(
                double => sub {
                    my ($instance, $batch) = @_;
                    $instance->emit(map { $_ * 2 } @$batch);
                },
                {
                    batch_size => 2,
                }
            )->init();

            $EMITTER->enqueue(1..3);
            $EMITTER->process_batch;

            is_deeply(
                [ $EMITTER->dequeue(2) ],
                [ 2, 4 ],
                'full batch - emit ok'
            );

            $EMITTER->process_batch;
            is_deeply(
                [ $EMITTER->dequeue(2) ],
                [ 6 ],
                'partial batch - emit ok'
            );
        };

        # Test recycle
        subtest "$APP - recycle" => sub {
            $CHILD->recycle(2);
            is($SMALL->pending, 1, 'fake recycle - ok');
            $SMALL->process_batch;
            $SMALL->dequeue;

            my $RECYCLER = Piper->new(
                mod_power_2 => {
                    allow => sub { $_[0] % 2 == 0 },
                    handler => sub {
                        my ($instance, $batch) = @_;
                        my @things = map { int( $_ / 2 ) } @$batch;
                        for my $thing (@things) {
                            if ($thing > 0 and $thing % 2 == 0) {
                                $instance->recycle($thing);
                            }
                            else {
                                $instance->emit($thing);
                            }
                        }
                    },
                },
                { batch_size => 3 },
            )->init();

            $RECYCLER->enqueue(2..4);
            $RECYCLER->process_batch;
            is($RECYCLER->pending, 1, 'recycle successful');
        };

        # Test eject
        subtest "$APP - eject" => sub {
            $CHILD->eject(2);
            is_deeply(
                [ $SMALL->dequeue ],
                [ 2 ],
                'ok'
            );
        };

        # Test inject
        subtest "$APP - inject" => sub {
            $CHILD->inject(2, 4, 6);
            is($SMALL->pending, 3, 'ok');
        };

        # Test injectAt
        subtest "$APP - injectAt" => sub {
            $SMALL->injectAt('half', 8, 10);
            is($CHILD->pending, 5, 'ok from pipe');
            $CHILD->injectAt('half', 12, 14);
            is($CHILD->pending, 7, 'ok from child');

            throws_ok {
                $SMALL->injectAt('bad', 1..4)
            } qr/Could not find bad to injectAt/, 'no inject with bad label';
        };

        # Test injectAfter
        subtest "$APP - injectAfter" => sub {
            $SMALL->injectAfter('half', 1..4);
            is($SMALL->ready, 4, 'ok from pipe');
            $CHILD->injectAfter('half', 5..8);
            is($SMALL->ready, 8, 'ok from child');

            throws_ok {
                $SMALL->injectAfter('bad', 1..4)
            } qr/Could not find bad to injectAfter/, 'no injectAfter with bad label';
        };

		# Test memory leak
		memory_cycle_ok($SMALL, "$APP - no memory leaks");
    };
}

#####################################################################

# Test args
{
    subtest "$APP - init args" => sub {
        my $argy = Piper->new(
            arg_check => {
                batch_size => 10,
                handler => sub {
                    my ($instance, $batch, @args) = @_;
                    if ($args[0] eq 'arg') {
                        $instance->emit(@$batch);
                    }
                },
            },
        )->init('arg');

        is($argy->args->[0], 'arg', 'stored ok');

        $argy->enqueue(1..2);
        $argy->process_batch;
        is_deeply(
            [ $argy->dequeue(2) ],
            [ 1..2 ],
            'passthrough to handler ok'
        );
    };
}

#####################################################################

subtest "$APP - nested pipes" => sub {
    my $TEST = Piper->new(
        integer => Piper->new(
            add_three => sub {
                my ($instance, $batch, @args) = @_;
                my @return = map { $_ + 3 } @$batch;
                for my $item (@return) {
                    if ($item < 0) {
                        $instance->recycle($item);
                    }
                    else {
                        $instance->emit($item);
                    }
                }
            },
            make_even => {
                batch_size => 4,
                # Non-explicitly testing that pass-in still works with $_ closure
                allow => sub { $_[0] % 2 != 0 },
                handler => sub {
                    my ($instance, $batch, @args) = @_;
                    my @return = map { $_ - 1 } @$batch;
                    for my $item (@return) {
                        if ($item < 0) {
                            $instance->injectAt('add_three', $item);
                        }
                        else {
                            $instance->emit($item);
                        }
                    }
                },
            },
            # Non-explicitly testing that allow $_ closure works
            { allow => sub { /^-?\d+$/ }, }
        ),
        {
            batch_size => 2,
            label => 'main',
        }
    )->init;

    my $CHILD = $TEST->children->[0];
    my $GRAND1 = $CHILD->children->[0];
    my $GRAND2 = $CHILD->children->[1];

    # Test path
    subtest "$APP - path" => sub {
        is($TEST->path, 'main', 'outside ok');
        is($CHILD->path, 'main/integer', 'first child ok');
        is($GRAND1->path,
            'main/integer/add_three', 'first grandchild ok'
        );
    };

    # Test parent predicate
    subtest "$APP - parent predicate" => sub {
        ok(!$TEST->has_parent, 'main no parent');
        ok($CHILD->has_parent, 'child has parent');
        ok($GRAND1->has_parent,
            'grandchild has parent'
        );

        is($CHILD->parent->path, 'main', "child's parent ok");
        is($GRAND1->parent->path,
            'main/integer', "grandchild's parent ok"
        );
    };

    # Test debug/verbose
    for my $type (qw(debug verbose)) {
        my $has = "has_$type";
        my $clear = "clear_$type";
        subtest "$APP - $type" => sub {
            ok(!$TEST->$has(), 'predicate');
            ok(!$GRAND1->$has(), 'grandchild predicate');
            is($TEST->$type(), 0, 'default');
            is($GRAND1->$type(), 0, 'grandchild default');

            $TEST->$type(1);
            ok($TEST->$has(), 'predicate after set');
            ok(!$GRAND1->$has(), 'grandchild predicate not affected');
            is($TEST->$type(), 1, 'writer ok');
            is($GRAND1->$type(), 1, 'grandchild inherits parent');

            $GRAND1->$type(2);
            ok($GRAND1->$has(), 'grandchild predicate after set');
            is($TEST->$type(), 1, 'parent not affected by grandchild');
            is($GRAND1->$type(), 2, 'grandchild no longer inherits');

            $GRAND1->$clear();
            ok(!$GRAND1->$has(), 'grandchild clearer ok');
            is($TEST->$type(), 1, 'parent unaffected by grandchild clearer');
            is($GRAND1->$type(), 1, 'grandchild inherits again');

            $TEST->$clear();
            ok(!$TEST->$has(), 'parent clearer ok');
        };
    }

    # Test batch_size
    subtest "$APP - batch_size" => sub {
        is($TEST->batch_size, 2, 'main ok');
        is($CHILD->batch_size, 2, 'child inherited ok');
        is($GRAND2->batch_size,
            4, 'child override ok'
        );
    };

    # Test queueing
    subtest "$APP - queueing" => sub {
        ok(!$TEST->pending, 'not yet pending');
        ok(!$TEST->ready, 'not yet ready');
        is($TEST->pressure, 0, 'no pressure');

        $TEST->enqueue(1..5);

        is($TEST->pending, 5, 'pending items');
        ok(!$TEST->ready, 'still not ready');
        is($TEST->pressure, 250, 'positive pressure');
    };

    # Test process_batch
    subtest "$APP - process_batch" => sub {
        $TEST->process_batch;

        is($GRAND1->pending, 3, 'processed first grandchild batch');
        is($GRAND2->pending + $GRAND2->ready, 2, 'sent to next grandchild');
        
        $TEST->process_batch;
        is($GRAND1->pending, 1, 'processed first grandchild again');
        is($GRAND2->pending + $GRAND2->ready, 4, 'sent to next grandchild again');


        $TEST->process_batch;
        is($GRAND1->pending, 0, 'finished processing first grandchild');
        is($GRAND2->pending + $GRAND2->ready, 5, 'next grandchild waiting');


        $TEST->process_batch;
        is($GRAND2->pending, 0, 'processed next grandchild');
        is($TEST->ready, 5, 'all done processing');
    };

    # Test dequeue
    subtest "$APP - dequeue" => sub {
        is_deeply(
            [ $TEST->dequeue(4) ],
            [ 4, 6, 8, 4 ],
            'dequeue multiple'
        );

        is($TEST->dequeue, 6, 'dequeue single');

        is_deeply(
            [ $TEST->dequeue(2) ],
            [],
            'dequeue empty'
        );
    };

    # Test exhaustion
    subtest "$APP - exhaustion" => sub {
        ok($TEST->is_exhausted, 'empty - is_exhausted');
        ok(!$TEST->isnt_exhausted, 'empty - isnt_exhausted');

        $TEST->enqueue(1);

        ok(!$TEST->is_exhausted, 'queued - is_exhausted');
        ok($TEST->isnt_exhausted, 'queued - isnt_exhausted');

        while ($TEST->isnt_exhausted) {
            $TEST->dequeue;
        }
        
        ok($TEST->is_exhausted, 'emptied - is_exhausted');
        ok(!$TEST->isnt_exhausted, 'emptied - isnt_exhausted');
    };

    # Test allow
    subtest "$APP - allow" => sub {
        $TEST->enqueue(1..8);
        $TEST->process_batch;

        is($GRAND2->pending, 1, 'one item allowed');
        is($GRAND2->ready, 1, 'one item skipped');

        $TEST->process_batch;
        $TEST->process_batch;
        $TEST->process_batch;

        is($GRAND2->pending, 4, 'expected items allowed');
        is($GRAND2->ready, 4, 'expected items skipped');

        $TEST->process_batch;
        is_deeply(
            [ $TEST->dequeue(8) ],
            [ 4, 6, 8, 10, 4, 6, 8, 10 ],
            'expected output received - allow was successful'
        );
    };

    # Test disabling
    subtest "$APP - disabling" => sub {
        $TEST->enabled(0);
        ok(!$TEST->enabled, 'disabled pipe');
        ok(!$CHILD->enabled, 'child inherits disable from parent');
        ok(!$GRAND2->enabled, 'grandchild inherits disable from grandparent');

        $TEST->enqueue(1..3);
        ok(!$TEST->pending, 'nothing pending in disabled pipe');
        is($TEST->ready, 3, 'items skipped disabled pipe');

        is_deeply(
            [ $TEST->dequeue(3) ],
            [ 1..3 ],
            'skipped items dequeued unchanged'
        );

        $TEST->enabled(1);
        $CHILD->enabled(0);
        ok($TEST->enabled, 'parent does not inherit disable from child');
        ok(!$GRAND1->enabled, 'grandchild inherits disable from child');

        $TEST->enqueue(1..3);
        ok(!$TEST->pending, 'nothing pending in pipe with 1 non-enabled child');
        is_deeply(
            [ $TEST->dequeue(3) ],
            [ 1..3 ],
            'skipped items dequeued unchanged from pipe with 1 non-enabled child'
        );

        $CHILD->enabled(1);
        $GRAND2->enabled(0);
        ok($TEST->enabled, 'parent does not inherit disable from grandchild');
        ok($CHILD->enabled, 'child does not inherit disable from grandchild');
        ok($GRAND1->enabled, 'sibling does not inherit disable');

        $TEST->enqueue(1..2);
        ok($TEST->pending, 'pending with one enabled grandchild');
        $TEST->process_batch;
        is($TEST->ready, 2, 'items only went through one grandchild');
        is_deeply(
            [ $TEST->dequeue(2) ],
            [ 4..5 ],
            'items dequeued, only processed by first grandchild'
        );
    };

	# Test memory leak
	memory_cycle_ok($TEST, "$APP - no memory leaks");
};

#####################################################################

done_testing();