The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More qw(no_plan);
use Test::Exception;

# We'll need this. We're feeling a little down.
sub seppuku { die "I'm not fit to bear the sword of a Samurai!\n" }
sub reconsider { seppuku if @_ and defined $_[0]->{die} and $_[0]->{die} }

my ($queue, $sub);
use_ok( "Sub::Deferrable", "Load module" );

# New queue
ok( $queue = Sub::Deferrable->new, "Constructor" );
is( $queue->deferring, 0, "Starts out in immediate mode." );
is( ref $queue->{queue}, "ARRAY", "Queue is an array" );
is( $#{$queue->{queue}}, -1, "Queue is empty" );

# Deferring the inevitable
ok( $sub = $queue->mk_deferrable( \&seppuku ), "Can wrap a sub" );
is( ref $sub, "CODE", "Returned object is a sub" );
throws_ok { &$sub } qr/Samurai/, "Immediate mode works";
$queue->defer;
lives_ok( sub { $sub->() }, "Deferred mode appears to work" );
throws_ok { $queue->undefer } qr/Samurai/, "Yes, yes it works";
is( $queue->deferring, 0, "Back in immediate mode." );
is( $#{$queue->{queue}}, -1, "Queue is again empty" );

# Maybe things aren't so bad after all. We CAN reconsider...
my $reconsider;
ok( $reconsider = $queue->mk_deferrable( \&reconsider ), "Wrap another sub" );
lives_ok( sub { $reconsider->({die => 0}) }, "Immediate mode works" );
throws_ok { $reconsider->({die => 1}) } qr/Samurai/, "...and works again" ;

# Let's enjoy our new-found freedom.
my $final_decision = { die => 0 };
lives_ok(sub { $reconsider->($final_decision) }, "Live to fight another day");
$final_decision->{die} = 1;	# Will our hero make it?
$queue->defer;			# Tune in next week!
lives_ok(sub { $reconsider->($final_decision) }, "Dying of suspense");
$final_decision->{die} = 0;	# Last-minute script change...
lives_ok(sub { $queue->undefer }, "And our hero is saved!");

# Need some fancy footwork to preserve call-time state...
use Storable qw( dclone );

# And let's block these last-minute script changes!
$final_decision->{die} = 1;
my $resolve;
ok($resolve = $queue->mk_deferrable( \&reconsider, \&dclone ), "Clone defer");
throws_ok { $resolve->($final_decision) } qr/Samurai/, "Immediate works still";
$queue->defer;
lives_ok( sub {$resolve->($final_decision)}, "Deferral worked" );
$final_decision->{die} = 0;	# Writers always figure something out...
throws_ok { $queue->undefer } qr/Samurai/, "And the decision was final!";


# Try more than one thing in the queue
{
    my $sub_ran = 0;
    my $sub = $queue->mk_deferrable( sub { $sub_ran++ } );

    $queue->defer;

    $sub->() for 1..5;
    is $sub_ran, 0, 'execution was deferred';
    is @{$queue->{queue}}, 5, 'five subs in queue';

    $queue->undefer;

    is $sub_ran, 5, 'five subs were run';
    is @{$queue->{queue}}, 0, 'queue is empty';
}

# Fill up the queue and then cancel
{
    my $sub_ran = 0;
    my $sub = $queue->mk_deferrable( sub { $sub_ran++ } );

    $queue->defer;

    $sub->() for 1..5;
    is $sub_ran, 0, 'execution was deferred';
    is @{$queue->{queue}}, 5, 'five subs in queue';

    $queue->cancel;

    is $sub_ran, 0, 'no subs were run';
    is @{$queue->{queue}}, 0, 'queue is empty';

    $queue->undefer;

    is $sub_ran, 0, 'still no subs were run';
}



# And when the queue dies halfway through?
{
    my $sub_ran = 0;
    my $sub = $queue->mk_deferrable( sub { $sub_ran++;  die "Poopie" if @_ } );
    $queue->defer;

    $sub->();
    $sub->();
    $sub->(1);
    $sub->();
    $sub->();

    is $sub_ran, 0, 'execution deferred';
    is @{$queue->{queue}}, 5, 'queue has five items';

    throws_ok { $queue->undefer } qr/^Poopie\b/;

    is $sub_ran, 3, 'three subs were run';
    is @{$queue->{queue}}, 2, 'two subs still in queue';

    lives_ok { $queue->undefer };
    is $sub_ran, 5, 'five subs were run';
    is @{$queue->{queue}}, 0, 'queue is now empty';
}