summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/00use.t11
-rw-r--r--t/01future.t290
-rw-r--r--t/02cancel.t131
-rw-r--r--t/03then.t290
-rw-r--r--t/04else.t259
-rw-r--r--t/05then-else.t78
-rw-r--r--t/06followed_by.t197
-rw-r--r--t/09transform.t75
-rw-r--r--t/10wait_all.t160
-rw-r--r--t/11wait_any.t152
-rw-r--r--t/12needs_all.t147
-rw-r--r--t/13needs_any.t200
-rw-r--r--t/20subclass.t138
-rw-r--r--t/21debug.t83
-rw-r--r--t/22wrap_cb.t105
-rw-r--r--t/30utils-call.t44
-rw-r--r--t/31utils-call-with-escape.t70
-rw-r--r--t/32utils-repeat.t188
-rw-r--r--t/33utils-repeat-generate.t65
-rw-r--r--t/34utils-repeat-foreach.t152
-rw-r--r--t/35utils-map-void.t200
-rw-r--r--t/36utils-map.t65
-rw-r--r--t/50test-future.t87
-rw-r--r--t/99pod.t11
24 files changed, 3198 insertions, 0 deletions
diff --git a/t/00use.t b/t/00use.t
new file mode 100644
index 0000000..dc88b8a
--- /dev/null
+++ b/t/00use.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok( "Future" );
+use_ok( "Future::Utils" );
+
+done_testing;
diff --git a/t/01future.t b/t/01future.t
new file mode 100644
index 0000000..03fb2db
--- /dev/null
+++ b/t/01future.t
@@ -0,0 +1,290 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Identity;
+use Test::Refcount;
+
+use Future;
+
+# done
+{
+ my $future = Future->new;
+
+ ok( defined $future, '$future defined' );
+ isa_ok( $future, "Future", '$future' );
+ is_oneref( $future, '$future has refcount 1 initially' );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+
+ my @on_ready_args;
+ identical( $future->on_ready( sub { @on_ready_args = @_ } ), $future, '->on_ready returns $future' );
+
+ my @on_done_args;
+ identical( $future->on_done( sub { @on_done_args = @_ } ), $future, '->on_done returns $future' );
+ identical( $future->on_fail( sub { die "on_fail called for done future" } ), $future, '->on_fail returns $future' );
+
+ identical( $future->done( result => "here" ), $future, '->done returns $future' );
+
+ is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' );
+ identical( $on_ready_args[0], $future, 'Future passed to on_ready' );
+ undef @on_ready_args;
+
+ is_deeply( \@on_done_args, [ result => "here" ], 'Results passed to on_done' );
+
+ ok( $future->is_ready, '$future is now ready' );
+ ok( $future->is_done, '$future is done' );
+ ok( !$future->is_failed, '$future is not failed' );
+ is_deeply( [ $future->get ], [ result => "here" ], 'Results from $future->get' );
+ is( scalar $future->get, "result", 'Result from scalar $future->get' );
+
+ is_oneref( $future, '$future has refcount 1 at end of test' );
+}
+
+# wrap
+{
+ my $f = Future->new;
+
+ my $future = Future->wrap( $f );
+
+ ok( defined $future, 'Future->wrap(Future) defined' );
+ isa_ok( $future, "Future", 'Future->wrap(Future)' );
+
+ $f->done( "Wrapped Future" );
+ is( scalar $future->get, "Wrapped Future", 'Future->wrap(Future)->get' );
+
+ $future = Future->wrap( "Plain string" );
+
+ ok( defined $future, 'Future->wrap(string) defined' );
+ isa_ok( $future, "Future", 'Future->wrap(string)' );
+
+ is( scalar $future->get, "Plain string", 'Future->wrap(string)->get' );
+}
+
+# done_cb
+{
+ my $future = Future->new;
+
+ my @on_done_args;
+ $future->on_done( sub { @on_done_args = @_ } );
+
+ my $done_cb = $future->done_cb;
+ is( ref $done_cb, "CODE", '->done_cb returns CODE reference' );
+
+ $done_cb->( result => "via cb" );
+ is_deeply( \@on_done_args, [ result => "via cb" ], 'Results via ->done_cb' );
+}
+
+# done chaining
+{
+ my $future = Future->new;
+
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ $future->on_done( $f1 );
+ $future->on_ready( $f2 );
+
+ my @on_done_args_1;
+ $f1->on_done( sub { @on_done_args_1 = @_ } );
+ my @on_done_args_2;
+ $f2->on_done( sub { @on_done_args_2 = @_ } );
+
+ $future->done( chained => "result" );
+
+ is_deeply( \@on_done_args_1, [ chained => "result" ], 'Results chained via ->on_done( $f )' );
+ is_deeply( \@on_done_args_2, [ chained => "result" ], 'Results chained via ->on_ready( $f )' );
+}
+
+# immediately done
+{
+ my $future = Future->done( already => "done" );
+
+ my @on_done_args;
+ identical( $future->on_done( sub { @on_done_args = @_; } ), $future, '->on_done returns future for immediate' );
+ my $on_fail;
+ identical( $future->on_fail( sub { $on_fail++; } ), $future, '->on_fail returns future for immediate' );
+
+ is_deeply( \@on_done_args, [ already => "done" ], 'Results passed to on_done for immediate future' );
+ ok( !$on_fail, 'on_fail not invoked for immediate future' );
+
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ $future->on_done( $f1 );
+ $future->on_ready( $f2 );
+
+ ok( $f1->is_ready, 'Chained ->on_done for immediate future' );
+ ok( $f1->is_done, 'Chained ->on_done is done for immediate future' );
+ is_deeply( [ $f1->get ], [ already => "done" ], 'Results from chained via ->on_done for immediate future' );
+ ok( $f2->is_ready, 'Chained ->on_ready for immediate future' );
+ ok( $f2->is_done, 'Chained ->on_ready is done for immediate future' );
+ is_deeply( [ $f2->get ], [ already => "done" ], 'Results from chained via ->on_ready for immediate future' );
+}
+
+# fail
+{
+ my $future = Future->new;
+
+ $future->on_done( sub { die "on_done called for failed future" } );
+ my $failure;
+ $future->on_fail( sub { ( $failure ) = @_; } );
+
+ identical( $future->fail( "Something broke" ), $future, '->fail returns $future' );
+
+ ok( $future->is_ready, '$future->fail marks future ready' );
+ ok( !$future->is_done, '$future->fail does not mark future done' );
+ ok( $future->is_failed, '$future->fail marks future as failed' );
+
+ is( scalar $future->failure, "Something broke", '$future->failure yields exception' );
+ my $file = __FILE__;
+ my $line = __LINE__ + 1;
+ like( exception { $future->get }, qr/^Something broke at \Q$file line $line\E\.?\n$/, '$future->get throws exception' );
+
+ is( $failure, "Something broke", 'Exception passed to on_fail' );
+}
+
+# fail_cb
+{
+ my $future = Future->new;
+
+ my $failure;
+ $future->on_fail( sub { ( $failure ) = @_ } );
+
+ my $fail_cb = $future->fail_cb;
+ is( ref $fail_cb, "CODE", '->fail_cb returns CODE reference' );
+
+ $fail_cb->( "Failure by cb" );
+ is( $failure, "Failure by cb", 'Failure via ->fail_cb' );
+}
+
+{
+ my $future = Future->new;
+
+ $future->fail( "Something broke", further => "details" );
+
+ ok( $future->is_ready, '$future->fail marks future ready' );
+
+ is( scalar $future->failure, "Something broke", '$future->failure yields exception' );
+ is_deeply( [ $future->failure ], [ "Something broke", "further", "details" ],
+ '$future->failure yields details in list context' );
+}
+
+# fail chaining
+{
+ my $future = Future->new;
+
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ $future->on_fail( $f1 );
+ $future->on_ready( $f2 );
+
+ my $failure_1;
+ $f1->on_fail( sub { ( $failure_1 ) = @_ } );
+ my $failure_2;
+ $f2->on_fail( sub { ( $failure_2 ) = @_ } );
+
+ $future->fail( "Chained failure" );
+
+ is( $failure_1, "Chained failure", 'Failure chained via ->on_fail( $f )' );
+ is( $failure_2, "Chained failure", 'Failure chained via ->on_ready( $f )' );
+}
+
+# immediately failed
+{
+ my $future = Future->fail( "Already broken" );
+
+ my $on_done;
+ identical( $future->on_done( sub { $on_done++; } ), $future, '->on_done returns future for immediate' );
+ my $failure;
+ identical( $future->on_fail( sub { ( $failure ) = @_; } ), $future, '->on_fail returns future for immediate' );
+
+ is( $failure, "Already broken", 'Exception passed to on_fail for already-failed future' );
+ ok( !$on_done, 'on_done not invoked for immediately-failed future' );
+
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ $future->on_fail( $f1 );
+ $future->on_ready( $f2 );
+
+ ok( $f1->is_ready, 'Chained ->on_done for immediate future' );
+ is_deeply( [ $f1->failure ], [ "Already broken" ], 'Results from chained via ->on_done for immediate future' );
+ ok( $f2->is_ready, 'Chained ->on_ready for immediate future' );
+ is_deeply( [ $f2->failure ], [ "Already broken" ], 'Results from chained via ->on_ready for immediate future' );
+}
+
+# die
+{
+ my $future = Future->new;
+
+ $future->on_done( sub { die "on_done called for failed future" } );
+ my $failure;
+ $future->on_fail( sub { ( $failure ) = @_; } );
+
+ my $file = __FILE__;
+ my $line = __LINE__+1;
+ identical( $future->die( "Something broke" ), $future, '->die returns $future' );
+
+ ok( $future->is_ready, '$future->die marks future ready' );
+
+ is( scalar $future->failure, "Something broke at $file line $line\n", '$future->failure yields exception' );
+ is( exception { $future->get }, "Something broke at $file line $line\n", '$future->get throws exception' );
+
+ is( $failure, "Something broke at $file line $line\n", 'Exception passed to on_fail' );
+}
+
+# call
+{
+ my $future;
+
+ $future = Future->call( sub { Future->done( @_ ) }, 1, 2, 3 );
+
+ ok( $future->is_ready, '$future->is_ready from immediate Future->call' );
+ is_deeply( [ $future->get ], [ 1, 2, 3 ], '$future->get from immediate Future->call' );
+
+ $future = Future->call( sub { die "argh!\n" } );
+
+ ok( $future->is_ready, '$future->is_ready from immediate exception of Future->call' );
+ is( $future->failure, "argh!\n", '$future->failure from immediate exception of Future->call' );
+
+ $future = Future->call( sub { "non-future" } );
+
+ ok( $future->is_ready, '$future->is_ready from non-future returning Future->call' );
+ like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/,
+ '$future->failure from non-future returning Future->call' );
+}
+
+# unwrap
+{
+ is_deeply( [ Future->unwrap( Future->done( 1, 2, 3 ) ) ],
+ [ 1, 2, 3 ],
+ 'Future->unwrap Future in list context' );
+ is_deeply( [ Future->unwrap( 1, 2, 3 ) ],
+ [ 1, 2, 3 ],
+ 'Future->unwrap plain list in list context' );
+
+ is( scalar Future->unwrap( Future->done( qw( a b c ) ) ),
+ "a",
+ 'Future->unwrap Future in scalar context' );
+ is( scalar Future->unwrap( qw( a b c ) ),
+ "a",
+ 'Future->unwrap plain list in scalar context' );
+}
+
+# label
+{
+ my $f = Future->new;
+
+ identical( $f->set_label( "the label" ), $f, '->set_label returns $f' );
+
+ is( $f->label, "the label", '->label returns the label' );
+
+ $f->cancel;
+}
+
+done_testing;
diff --git a/t/02cancel.t b/t/02cancel.t
new file mode 100644
index 0000000..bea0e3b
--- /dev/null
+++ b/t/02cancel.t
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Identity;
+
+use Future;
+
+# cancel
+{
+ my $future = Future->new;
+
+ my $cancelled;
+
+ identical( $future->on_cancel( sub { $cancelled .= "1" } ), $future, '->on_cancel returns $future' );
+ $future->on_cancel( sub { $cancelled .= "2" } );
+
+ my $ready;
+ $future->on_ready( sub { $ready++ if shift->is_cancelled } );
+
+ $future->on_done( sub { die "on_done called for cancelled future" } );
+ $future->on_fail( sub { die "on_fail called for cancelled future" } );
+
+ $future->on_ready( my $ready_f = Future->new );
+ $future->on_done( my $done_f = Future->new );
+ $future->on_fail( my $fail_f = Future->new );
+
+ $future->cancel;
+
+ ok( $future->is_ready, '$future->cancel marks future ready' );
+
+ ok( $future->is_cancelled, '$future->cancelled now true' );
+ is( $cancelled, "21", '$future cancel blocks called in reverse order' );
+
+ is( $ready, 1, '$future on_ready still called by cancel' );
+
+ ok( $ready_f->is_cancelled, 'on_ready chained future cnacelled after cancel' );
+ ok( !$done_f->is_ready, 'on_done chained future not ready after cancel' );
+ ok( !$fail_f->is_ready, 'on_fail chained future not ready after cancel' );
+
+ like( exception { $future->get }, qr/cancelled/, '$future->get throws exception by cancel' );
+
+ ok( !exception { $future->cancel }, '$future->cancel a second time is OK' );
+
+ $done_f->cancel;
+ $fail_f->cancel;
+}
+
+# cancel_cb
+{
+ my $future = Future->new;
+
+ my $cancelled;
+ $future->on_cancel( sub { $cancelled++ } );
+
+ my $cancel_cb = $future->cancel_cb;
+ is( ref $cancel_cb, "CODE", '->cancel_cb returns CODE reference' );
+
+ $cancel_cb->();
+ is( $cancelled, 1, 'Cancellation via ->cancel_cb' );
+}
+
+# immediately cancelled
+{
+ my $future = Future->new;
+ $future->cancel;
+
+ my $ready_called;
+ $future->on_ready( sub { $ready_called++ } );
+ my $done_called;
+ $future->on_done( sub { $done_called++ } );
+ my $fail_called;
+ $future->on_fail( sub { $fail_called++ } );
+
+ $future->on_ready( my $ready_f = Future->new );
+ $future->on_done( my $done_f = Future->new );
+ $future->on_fail( my $fail_f = Future->new );
+
+ is( $ready_called, 1, 'on_ready invoked for already-cancelled future' );
+ ok( !$done_called, 'on_done not invoked for already-cancelled future' );
+ ok( !$fail_called, 'on_fail not invoked for already-cancelled future' );
+
+ ok( $ready_f->is_cancelled, 'on_ready chained future cnacelled for already-cancelled future' );
+ ok( !$done_f->is_ready, 'on_done chained future not ready for already-cancelled future' );
+ ok( !$fail_f->is_ready, 'on_fail chained future not ready for already-cancelled future' );
+
+ $done_f->cancel;
+ $fail_f->cancel;
+}
+
+# cancel chaining
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ $f1->on_cancel( $f2 );
+ my $cancelled;
+ $f2->on_cancel( sub { $cancelled++ } );
+
+ $f1->cancel;
+ is( $cancelled, 1, 'Chained cancellation' );
+}
+
+# ->done on cancelled
+{
+ my $f = Future->new;
+ $f->cancel;
+
+ ok( eval { $f->done( "ignored" ); 1 }, '->done on cancelled future is ignored' );
+ ok( eval { $f->fail( "ignored" ); 1 }, '->fail on cancelled future is ignored' );
+}
+
+# without_cancel
+{
+ my $f1 = Future->new;
+ my $f2 = $f1->without_cancel;
+
+ $f2->cancel;
+ ok( !$f1->is_cancelled, '$f1 not cancelled just because $f2 is' );
+
+ my $f3 = $f1->without_cancel;
+ $f1->done( "result" );
+
+ ok( $f3->is_ready, '$f3 ready when $f1 is' );
+ is_deeply( [ $f3->get ], [ "result" ], 'result of $f3' );
+}
+
+done_testing;
diff --git a/t/03then.t b/t/03then.t
new file mode 100644
index 0000000..9daea09
--- /dev/null
+++ b/t/03then.t
@@ -0,0 +1,290 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Refcount;
+use Test::Identity;
+
+use Future;
+
+# then success
+{
+ my $f1 = Future->new;
+
+ my $f2;
+ my $fseq = $f1->then(
+ sub {
+ is( $_[0], "f1 result", 'then done block passed result of $f1' );
+ return $f2 = Future->new;
+ }
+ );
+
+ ok( defined $fseq, '$fseq defined' );
+ isa_ok( $fseq, "Future", '$fseq' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 initially' );
+
+ ok( !$f2, '$f2 not yet defined before $f1 done' );
+
+ $f1->done( "f1 result" );
+
+ ok( defined $f2, '$f2 now defined after $f1 done' );
+
+ undef $f1;
+ is_oneref( $fseq, '$fseq has refcount 1 after $f1 done and dropped' );
+
+ ok( !$fseq->is_ready, '$fseq not yet done before $f2 done' );
+
+ $f2->done( results => "here" );
+
+ ok( $fseq->is_ready, '$fseq is done after $f2 done' );
+ is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' );
+
+ undef $f2;
+ is_oneref( $fseq, '$fseq has refcount 1 before EOF' );
+}
+
+# then failure in f1
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->then(
+ sub { die "then of failed Future should not be invoked" }
+ );
+
+ $f1->fail( "A failure\n" );
+
+ ok( $fseq->is_ready, '$fseq is now ready after $f1 fail' );
+
+ is( scalar $fseq->failure, "A failure\n", '$fseq fails when $f1 fails' );
+}
+
+# then failure in f2
+{
+ my $f1 = Future->new;
+
+ my $f2;
+ my $fseq = $f1->then(
+ sub { return $f2 = Future->new }
+ );
+
+ $f1->done;
+ $f2->fail( "Another failure\n" );
+
+ ok( $fseq->is_ready, '$fseq is now ready after $f2 fail' );
+
+ is( scalar $fseq->failure, "Another failure\n", '$fseq fails when $f2 fails' );
+}
+
+# code dies
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->then( sub {
+ die "It fails\n";
+ } );
+
+ ok( !defined exception { $f1->done }, 'exception not propagated from done call' );
+
+ ok( $fseq->is_ready, '$fseq is ready after code exception' );
+ is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' );
+}
+
+# immediately done
+{
+ my $f1 = Future->done( "Result" );
+
+ my $f2;
+ my $fseq = $f1->then(
+ sub { return $f2 = Future->new }
+ );
+
+ ok( defined $f2, '$f2 defined for immediate done' );
+
+ $f2->done( "Final" );
+
+ ok( $fseq->is_ready, '$fseq already ready for immediate done' );
+ is( scalar $fseq->get, "Final", '$fseq->get for immediate done' );
+}
+
+# immediately fail
+{
+ my $f1 = Future->fail( "Failure\n" );
+
+ my $fseq = $f1->then(
+ sub { die "then of immediately-failed future should not be invoked" }
+ );
+
+ ok( $fseq->is_ready, '$fseq already ready for immediate fail' );
+ is( scalar $fseq->failure, "Failure\n", '$fseq->failure for immediate fail' );
+}
+
+# done fallthrough
+{
+ my $f1 = Future->new;
+ my $fseq = $f1->then;
+
+ $f1->done( "fallthrough result" );
+
+ ok( $fseq->is_ready, '$fseq is ready' );
+ is( scalar $fseq->get, "fallthrough result", '->then done fallthrough' );
+}
+
+# fail fallthrough
+{
+ my $f1 = Future->new;
+ my $fseq = $f1->then;
+
+ $f1->fail( "fallthrough failure\n" );
+
+ ok( $fseq->is_ready, '$fseq is ready' );
+ is( scalar $fseq->failure, "fallthrough failure\n", '->then fail fallthrough' );
+}
+
+# then cancel
+{
+ my $f1 = Future->new;
+ my $fseq = $f1->then( sub { die "then done of cancelled Future should not be invoked" } );
+
+ $fseq->cancel;
+
+ ok( $f1->is_cancelled, '$f1 is cancelled by $fseq cancel' );
+
+ $f1 = Future->new;
+ my $f2;
+ $fseq = $f1->then( sub { return $f2 = Future->new } );
+
+ $f1->done;
+ $fseq->cancel;
+
+ ok( $f2->is_cancelled, '$f2 cancelled by $fseq cancel' );
+}
+
+# then dropping $fseq doesn't fail ->done
+{
+ local $SIG{__WARN__} = sub {};
+
+ my $f1 = Future->new;
+ my $fseq = $f1->then( sub { return Future->done() } );
+
+ undef $fseq;
+
+ is( exception { $f1->done; }, undef,
+ 'Dropping $fseq does not cause $f1->done to die' );
+}
+
+# Void context raises a warning
+{
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0]; };
+
+ Future->done->then(
+ sub { Future->new }
+ );
+ like( $warnings,
+ qr/^Calling ->then in void context /,
+ 'Warning in void context' );
+}
+
+# Non-Future return raises exception
+{
+ my $f1 = Future->new;
+
+ my $file = __FILE__;
+ my $line = __LINE__+1;
+ my $fseq = $f1->then( sub {} );
+ my $fseq2 = $f1->then( sub { Future->done } );
+
+ ok( !exception { $f1->done },
+ '->done with non-Future return from ->then does not die' );
+
+ like( $fseq->failure,
+ qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/,
+ 'Failure from non-Future return from ->then' );
+
+ ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' );
+
+ my $fseq3;
+ ok( !exception { $fseq3 = $f1->then( sub {} ) },
+ 'non-Future return from ->then on immediate does not die' );
+
+ like( $fseq3->failure,
+ qr/^Expected __ANON__\(.*\) to return a Future/,
+ 'Failure from non-Future return from ->then on immediate' );
+}
+
+# then_with_f
+{
+ my $f1 = Future->new;
+
+ my $f2;
+ my $fseq = $f1->then_with_f(
+ sub {
+ identical( $_[0], $f1, 'then_with_f block passed $f1' );
+ is( $_[1], "f1 result", 'then_with_f block pased result of $f1' );
+ return $f2 = Future->new;
+ }
+ );
+
+ ok( defined $fseq, '$fseq defined' );
+
+ $f1->done( "f1 result" );
+
+ ok( defined $f2, '$f2 defined after $f1->done' );
+
+ $f2->done( "f2 result" );
+
+ ok( $fseq->is_ready, '$fseq is done after $f2 done' );
+ is( scalar $fseq->get, "f2 result", '$fseq->get returns results' );
+}
+
+# then_done
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->then_done( second => "result" );
+
+ $f1->done( first => );
+
+ ok( $fseq->is_ready, '$fseq done after $f1 done' );
+ is_deeply( [ $fseq->get ], [ second => "result" ], '$fseq->get returns result for then_done' );
+
+ my $fseq2 = $f1->then_done( third => "result" );
+
+ ok( $fseq2->is_ready, '$fseq2 done after ->then_done on immediate' );
+ is_deeply( [ $fseq2->get ], [ third => "result" ], '$fseq2->get returns result for then_done on immediate' );
+
+ my $f2 = Future->new;
+ $fseq = $f2->then_done( "result" );
+ $f2->fail( "failure" );
+
+ is( scalar $fseq->failure, "failure", '->then_done ignores failure' );
+}
+
+# then_fail
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->then_fail( second => "result" );
+
+ $f1->done( first => );
+
+ ok( $fseq->is_ready, '$fseq done after $f1 done' );
+ is_deeply( [ $fseq->failure ], [ second => "result" ], '$fseq->failure returns result for then_fail' );
+
+ my $fseq2 = $f1->then_fail( third => "result" );
+
+ ok( $fseq2->is_ready, '$fseq2 done after ->then_fail on immediate' );
+ is_deeply( [ $fseq2->failure ], [ third => "result" ], '$fseq2->failure returns result for then_fail on immediate' );
+
+ my $f2 = Future->new;
+ $fseq = $f2->then_fail( "fail2" );
+ $f2->fail( "failure" );
+
+ is( scalar $fseq->failure, "failure", '->then_fail ignores failure' );
+}
+
+done_testing;
diff --git a/t/04else.t b/t/04else.t
new file mode 100644
index 0000000..2cbc546
--- /dev/null
+++ b/t/04else.t
@@ -0,0 +1,259 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Refcount;
+use Test::Identity;
+
+use Future;
+
+# else success
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->else(
+ sub { die "else of successful Future should not be invoked" }
+ );
+
+ ok( defined $fseq, '$fseq defined' );
+ isa_ok( $fseq, "Future", '$fseq' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 initially' );
+
+ $f1->done( results => "here" );
+
+ is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq succeeds when $f1 succeeds' );
+
+ undef $f1;
+ is_oneref( $fseq, '$fseq has refcount 1 before EOF' );
+}
+
+# else failure
+{
+ my $f1 = Future->new;
+
+ my $f2;
+ my $fseq = $f1->else(
+ sub {
+ is( $_[0], "f1 failure\n", 'then fail block passed result of $f1' );
+ return $f2 = Future->new;
+ }
+ );
+
+ ok( defined $fseq, '$fseq defined' );
+ isa_ok( $fseq, "Future", '$fseq' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 initially' );
+
+ ok( !$f2, '$f2 not yet defined before $f1 fails' );
+
+ $f1->fail( "f1 failure\n" );
+
+ undef $f1;
+ is_oneref( $fseq, '$fseq has refcount 1 after $f1 fail and dropped' );
+
+ ok( defined $f2, '$f2 now defined after $f1 fails' );
+
+ ok( !$fseq->is_ready, '$fseq not yet done before $f2 done' );
+
+ $f2->done( results => "here" );
+
+ ok( $fseq->is_ready, '$fseq is done after $f2 done' );
+ is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' );
+
+ undef $f2;
+ is_oneref( $fseq, '$fseq has refcount 1 before EOF' );
+}
+
+# Double failure
+{
+ my $f1 = Future->new;
+
+ my $f2;
+ my $fseq = $f1->else(
+ sub { return $f2 = Future->new }
+ );
+
+ $f1->fail( "First failure\n" );
+ $f2->fail( "Another failure\n" );
+
+ is( scalar $fseq->failure, "Another failure\n", '$fseq fails when $f2 fails' );
+}
+
+# code dies
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->else( sub {
+ die "It fails\n";
+ } );
+
+ ok( !defined exception { $f1->fail( "bork" ) }, 'exception not propagated from fail call' );
+
+ ok( $fseq->is_ready, '$fseq is ready after code exception' );
+ is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' );
+}
+
+# immediate fail
+{
+ my $f1 = Future->fail( "Failure\n" );
+
+ my $f2;
+ my $fseq = $f1->else(
+ sub { return $f2 = Future->new }
+ );
+
+ ok( defined $f2, '$f2 defined for immediate fail' );
+
+ $f2->fail( "Another failure\n" );
+
+ ok( $fseq->is_ready, '$fseq already ready for immediate fail' );
+ is( scalar $fseq->failure, "Another failure\n", '$fseq->failure for immediate fail' );
+}
+
+# immediate done
+{
+ my $f1 = Future->done( "It works" );
+
+ my $fseq = $f1->else(
+ sub { die "else block invoked for immediate done Future" }
+ );
+
+ ok( $fseq->is_ready, '$fseq already ready for immediate done' );
+ is( scalar $fseq->get, "It works", '$fseq->get for immediate done' );
+}
+
+# else cancel
+{
+ my $f1 = Future->new;
+ my $fseq = $f1->else( sub { die "else of cancelled Future should not be invoked" } );
+
+ $fseq->cancel;
+
+ ok( $f1->is_cancelled, '$f1 is cancelled by $fseq cancel' );
+
+ $f1 = Future->new;
+ my $f2;
+ $fseq = $f1->else( sub { return $f2 = Future->new } );
+
+ $f1->fail( "A failure\n" );
+ $fseq->cancel;
+
+ ok( $f2->is_cancelled, '$f2 cancelled by $fseq cancel' );
+}
+
+# Void context raises a warning
+{
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0]; };
+
+ Future->done->else(
+ sub { Future->new }
+ );
+ like( $warnings,
+ qr/^Calling ->else in void context /,
+ 'Warning in void context' );
+}
+
+# Non-Future return raises exception
+{
+ my $f1 = Future->new;
+
+ my $file = __FILE__;
+ my $line = __LINE__+1;
+ my $fseq = $f1->else( sub {} );
+ my $fseq2 = $f1->else( sub { Future->done } );
+
+ ok( !exception { $f1->fail( "failed\n" ) },
+ '->fail with non-Future return from ->else does not die' );
+
+ like( $fseq->failure,
+ qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/,
+ 'Failure from non-Future return from ->else' );
+
+ ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' );
+
+ my $fseq3;
+ ok( !exception { $fseq3 = $f1->else( sub {} ) },
+ 'non-Future return from ->else on immediate does not die' );
+
+ like( $fseq3->failure,
+ qr/^Expected __ANON__\(.*\) to return a Future/,
+ 'Failure from non-Future return from ->else on immediate' );
+}
+
+# else_with_f
+{
+ my $f1 = Future->new;
+
+ my $f2;
+ my $fseq = $f1->else_with_f(
+ sub {
+ identical( $_[0], $f1, 'else_with_f block passed $f1' );
+ is( $_[1], "f1 failure\n", 'else_with_f block pased failure of $f1' );
+ return $f2 = Future->new;
+ }
+ );
+
+ ok( defined $fseq, '$fseq defined' );
+
+ $f1->fail( "f1 failure\n" );
+
+ ok( defined $f2, '$f2 defined after $f1->fail' );
+
+ $f2->done( "f2 result" );
+
+ ok( $fseq->is_ready, '$fseq is done after $f2 done' );
+ is( scalar $fseq->get, "f2 result", '$fseq->get returns results' );
+}
+
+# else_done
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->else_done( second => "result" );
+
+ $f1->fail( first => );
+
+ ok( $fseq->is_ready, '$fseq done after $f1 done' );
+ is_deeply( [ $fseq->get ], [ second => "result" ], '$fseq->get returns result for else_done' );
+
+ my $fseq2 = $f1->else_done( third => "result" );
+
+ ok( $fseq2->is_ready, '$fseq2 done after ->else_done on immediate' );
+ is_deeply( [ $fseq2->get ], [ third => "result" ], '$fseq2->get returns result for else_done on immediate' );
+
+ my $f2 = Future->new;
+ $fseq = $f2->else_done( "result2" );
+ $f2->done( "result" );
+
+ is( scalar $fseq->get, "result", '->else_done ignores success' );
+}
+
+# else_fail
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->else_fail( second => "result" );
+
+ $f1->fail( first => );
+
+ ok( $fseq->is_ready, '$fseq done after $f1 done' );
+ is_deeply( [ $fseq->failure ], [ second => "result" ], '$fseq->failure returns result for else_fail' );
+
+ my $fseq2 = $f1->else_fail( third => "result" );
+
+ ok( $fseq2->is_ready, '$fseq2 done after ->else_fail on immediate' );
+ is_deeply( [ $fseq2->failure ], [ third => "result" ], '$fseq2->failure returns result for else_fail on immediate' );
+
+ my $f2 = Future->new;
+ $fseq = $f2->else_fail( "failure" );
+ $f2->done( "result" );
+
+ is( scalar $fseq->get, "result", '->else_fail ignores success' );
+}
+
+done_testing;
diff --git a/t/05then-else.t b/t/05then-else.t
new file mode 100644
index 0000000..ff35ac7
--- /dev/null
+++ b/t/05then-else.t
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+use Future;
+
+# then done
+{
+ my $f1 = Future->new;
+
+ my $fdone;
+ my $fseq = $f1->then(
+ sub {
+ is( $_[0], "f1 result", '2-arg then done block passed result of $f1' );
+ return $fdone = Future->new;
+ },
+ sub {
+ die "then fail block should not be invoked";
+ },
+ );
+
+ $f1->done( "f1 result" );
+
+ ok( defined $fdone, '$fdone now defined after $f1 done' );
+
+ $fdone->done( results => "here" );
+
+ ok( $fseq->is_ready, '$fseq is done after $fdone done' );
+ is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' );
+}
+
+# then fail
+{
+ my $f1 = Future->new;
+
+ my $ffail;
+ my $fseq = $f1->then(
+ sub {
+ die "then done block should not be invoked";
+ },
+ sub {
+ is( $_[0], "The failure\n", '2-arg then fail block passed failure of $f1' );
+ return $ffail = Future->new;
+ },
+ );
+
+ $f1->fail( "The failure\n" );
+
+ ok( defined $ffail, '$ffail now defined after $f1 fail' );
+
+ $ffail->done( fallback => "result" );
+
+ ok( $fseq->is_ready, '$fseq is done after $ffail fail' );
+ is_deeply( [ $fseq->get ], [ fallback => "result" ], '$fseq->get returns results' );
+}
+
+# then done fails doesn't trigger fail block
+{
+ my $f1 = Future->new;
+
+ my $fdone;
+ my $fseq = $f1->then(
+ sub { $fdone = Future->new; },
+ sub { die "then fail block should not be invoked"; },
+ );
+
+ $f1->done( "Done" );
+ $fdone->fail( "The failure\n" );
+
+ ok( $fseq->is_ready, '$fseq is ready after $fdone fail' );
+ ok( scalar $fseq->failure, '$fseq failed after $fdone fail' );
+}
+
+done_testing;
diff --git a/t/06followed_by.t b/t/06followed_by.t
new file mode 100644
index 0000000..3c9418d
--- /dev/null
+++ b/t/06followed_by.t
@@ -0,0 +1,197 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Identity;
+use Test::Refcount;
+
+use Future;
+
+{
+ my $f1 = Future->new;
+
+ my $called = 0;
+ my $fseq = $f1->followed_by( sub {
+ $called++;
+ identical( $_[0], $f1, 'followed_by block passed $f1' );
+ return $_[0];
+ } );
+
+ ok( defined $fseq, '$fseq defined' );
+ isa_ok( $fseq, "Future", '$fseq' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 initially' );
+ # Two refs; one in lexical $f1, one in $fseq's cancellation closure
+ is_refcount( $f1, 2, '$f1 has refcount 2 initially' );
+
+ is( $called, 0, '$called before $f1 done' );
+
+ $f1->done( results => "here" );
+
+ is( $called, 1, '$called after $f1 done' );
+
+ ok( $fseq->is_ready, '$fseq is done after $f1 done' );
+ is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 before EOF' );
+ is_oneref( $f1, '$f1 has refcount 1 before EOF' );
+}
+
+{
+ my $f1 = Future->new;
+
+ my $called = 0;
+ my $fseq = $f1->followed_by( sub {
+ $called++;
+ identical( $_[0], $f1, 'followed_by block passed $f1' );
+ return $_[0];
+ } );
+
+ ok( defined $fseq, '$fseq defined' );
+ isa_ok( $fseq, "Future", '$fseq' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 initially' );
+
+ is( $called, 0, '$called before $f1 done' );
+
+ $f1->fail( "failure\n" );
+
+ is( $called, 1, '$called after $f1 failed' );
+
+ ok( $fseq->is_ready, '$fseq is ready after $f1 failed' );
+ is_deeply( [ $fseq->failure ], [ "failure\n" ], '$fseq->get returns failure' );
+
+ is_oneref( $fseq, '$fseq has refcount 1 before EOF' );
+}
+
+# code dies
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->followed_by( sub {
+ die "It fails\n";
+ } );
+
+ ok( !defined exception { $f1->done }, 'exception not propagated from code call' );
+
+ ok( $fseq->is_ready, '$fseq is ready after code exception' );
+ is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' );
+}
+
+# Cancellation
+{
+ my $f1 = Future->new;
+
+ my $fseq = $f1->followed_by(
+ sub { die "followed_by of cancelled Future should not be invoked" }
+ );
+
+ $fseq->cancel;
+
+ ok( $f1->is_cancelled, '$f1 cancelled by $fseq->cancel' );
+
+ $f1 = Future->new;
+ my $f2 = Future->new;
+
+ $fseq = $f1->followed_by( sub { $f2 } );
+
+ $f1->done;
+ $fseq->cancel;
+
+ ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel' );
+
+ $f1 = Future->done;
+ $f2 = Future->new;
+
+ $fseq = $f1->followed_by( sub { $f2 } );
+
+ $fseq->cancel;
+
+ ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel on $f1 immediate' );
+}
+
+# immediately done
+{
+ my $f1 = Future->done;
+
+ my $called = 0;
+ my $fseq = $f1->followed_by(
+ sub { $called++; return $_[0] }
+ );
+
+ is( $called, 1, 'followed_by block invoked immediately for already-done' );
+}
+
+# immediately done
+{
+ my $f1 = Future->fail("Failure\n");
+
+ my $called = 0;
+ my $fseq = $f1->followed_by(
+ sub { $called++; return $_[0] }
+ );
+
+ is( $called, 1, 'followed_by block invoked immediately for already-failed' );
+}
+
+# immediately code dies
+{
+ my $f1 = Future->done;
+
+ my $fseq;
+
+ ok( !defined exception {
+ $fseq = $f1->followed_by( sub {
+ die "It fails\n";
+ } );
+ }, 'exception not propagated from ->followed_by on immediate' );
+
+ ok( $fseq->is_ready, '$fseq is ready after code exception on immediate' );
+ is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception on immediate' );
+}
+
+# Void context raises a warning
+{
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0]; };
+
+ Future->done->followed_by(
+ sub { Future->new }
+ );
+
+ like( $warnings,
+ qr/^Calling ->followed_by in void context at /,
+ 'Warning in void context' );
+}
+
+# Non-Future return raises exception
+{
+ my $f1 = Future->new;
+
+ my $file = __FILE__;
+ my $line = __LINE__+1;
+ my $fseq = $f1->followed_by( sub {} );
+ my $fseq2 = $f1->followed_by( sub { Future->done } );
+
+ ok( !exception { $f1->done },
+ '->done with non-Future return from ->followed_by does not die' );
+
+ like( $fseq->failure,
+ qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/,
+ 'Failure from non-Future return from ->followed_by' );
+
+ ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' );
+
+ my $fseq3;
+ ok( !exception { $fseq3 = $f1->followed_by( sub {} ) },
+ 'non-Future return from ->followed_by on immediate does not die' );
+
+ like( $fseq3->failure,
+ qr/^Expected __ANON__\(.*\) to return a Future/,
+ 'Failure from non-Future return from ->followed_by on immediate' );
+}
+
+done_testing;
diff --git a/t/09transform.t b/t/09transform.t
new file mode 100644
index 0000000..67f7e25
--- /dev/null
+++ b/t/09transform.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Future;
+
+# Result transformation
+{
+ my $f1 = Future->new;
+
+ my $future = $f1->transform(
+ done => sub { result => @_ },
+ );
+
+ $f1->done( 1, 2, 3 );
+
+ is_deeply( [ $future->get ], [ result => 1, 2, 3 ], '->transform result' );
+}
+
+# Failure transformation
+{
+ my $f1 = Future->new;
+
+ my $future = $f1->transform(
+ fail => sub { "failure\n" => @_ },
+ );
+
+ $f1->fail( "something failed\n" );
+
+ is_deeply( [ $future->failure ], [ "failure\n" => "something failed\n" ], '->transform failure' );
+}
+
+# code dies
+{
+ my $f1 = Future->new;
+
+ my $future = $f1->transform(
+ done => sub { die "It fails\n" },
+ );
+
+ $f1->done;
+
+ is_deeply( [ $future->failure ], [ "It fails\n" ], '->transform catches exceptions' );
+}
+
+# Cancellation
+{
+ my $f1 = Future->new;
+
+ my $cancelled;
+ $f1->on_cancel( sub { $cancelled++ } );
+
+ my $future = $f1->transform;
+
+ $future->cancel;
+ is( $cancelled, 1, '->transform cancel' );
+}
+
+# Void context raises a warning
+{
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0]; };
+
+ Future->done->transform(
+ done => sub { }
+ );
+ like( $warnings,
+ qr/^Calling ->transform in void context at /,
+ 'Warning in void context' );
+}
+
+done_testing;
diff --git a/t/10wait_all.t b/t/10wait_all.t
new file mode 100644
index 0000000..9331b61
--- /dev/null
+++ b/t/10wait_all.t
@@ -0,0 +1,160 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Identity;
+use Test::Refcount;
+
+use Future;
+
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->wait_all( $f1, $f2 );
+ is_oneref( $future, '$future has refcount 1 initially' );
+
+ # Two refs; one lexical here, one in $future
+ is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->wait_all' );
+ is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->wait_all' );
+
+ is_deeply( [ $future->pending_futures ],
+ [ $f1, $f2 ],
+ '$future->pending_futures before any ready' );
+
+ is_deeply( [ $future->ready_futures ],
+ [],
+ '$future->done_futures before any ready' );
+
+ my @on_ready_args;
+ $future->on_ready( sub { @on_ready_args = @_ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+ is( scalar @on_ready_args, 0, 'on_ready not yet invoked' );
+
+ $f1->done( one => 1 );
+
+ is_deeply( [ $future->pending_futures ],
+ [ $f2 ],
+ '$future->pending_futures after $f1 ready' );
+
+ is_deeply( [ $future->ready_futures ],
+ [ $f1 ],
+ '$future->ready_futures after $f1 ready' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f1 ],
+ '$future->done_futures after $f1 ready' );
+
+ ok( !$future->is_ready, '$future still not yet ready after f1 ready' );
+ is( scalar @on_ready_args, 0, 'on_ready not yet invoked' );
+
+ $f2->done( two => 2 );
+
+ is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' );
+ identical( $on_ready_args[0], $future, 'Future passed to on_ready' );
+ undef @on_ready_args;
+
+ ok( $future->is_ready, '$future now ready after f2 ready' );
+ my @results = $future->get;
+ identical( $results[0], $f1, 'Results[0] from $future->get is f1' );
+ identical( $results[1], $f2, 'Results[1] from $future->get is f2' );
+ undef @results;
+
+ is_deeply( [ $future->pending_futures ],
+ [],
+ '$future->pending_futures after $f2 ready' );
+
+ is_deeply( [ $future->ready_futures ],
+ [ $f1, $f2 ],
+ '$future->ready_futures after $f2 ready' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f1, $f2 ],
+ '$future->done_futures after $f2 ready' );
+
+ is_refcount( $future, 1, '$future has refcount 1 at end of test' );
+ undef $future;
+
+ is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' );
+ is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' );
+}
+
+# immediately done
+{
+ my $f1 = Future->done;
+
+ my $future = Future->wait_all( $f1 );
+
+ ok( $future->is_ready, '$future of already-ready sub already ready' );
+ my @results = $future->get;
+ identical( $results[0], $f1, 'Results from $future->get of already ready' );
+}
+
+# one immediately done
+{
+ my $f1 = Future->done;
+ my $f2 = Future->new;
+
+ my $future = Future->wait_all( $f1, $f2 );
+
+ ok( !$future->is_ready, '$future of partially-done subs not yet ready' );
+
+ $f2->done;
+
+ ok( $future->is_ready, '$future of completely-done subs already ready' );
+ my @results = $future->get;
+ identical( $results[0], $f1, 'Results from $future->get of already ready' );
+}
+
+# cancel propagation
+{
+ my $f1 = Future->new;
+ my $c1;
+ $f1->on_cancel( sub { $c1++ } );
+
+ my $f2 = Future->new;
+ my $c2;
+ $f2->on_cancel( sub { $c2++ } );
+
+ my $future = Future->wait_all( $f1, $f2 );
+
+ $f2->done;
+
+ $future->cancel;
+
+ is( $c1, 1, '$future->cancel marks subs cancelled' );
+ is( $c2, undef, '$future->cancel ignores ready subs' );
+}
+
+# cancelled convergent
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->wait_all( $f1, $f2 );
+
+ $f1->done( "result" );
+ $f2->cancel;
+
+ ok( $future->is_ready, '$future of cancelled sub is ready after final cancellation' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f1 ],
+ '->done_futures with cancellation' );
+ is_deeply( [ $future->cancelled_futures ],
+ [ $f2 ],
+ '->cancelled_futures with cancellation' );
+}
+
+# wait_all on none
+{
+ my $f = Future->wait_all( () );
+
+ ok( $f->is_ready, 'wait_all on no Futures already done' );
+ is_deeply( [ $f->get ], [], '->get on empty wait_all is empty' );
+}
+
+done_testing;
diff --git a/t/11wait_any.t b/t/11wait_any.t
new file mode 100644
index 0000000..c72629e
--- /dev/null
+++ b/t/11wait_any.t
@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Identity;
+use Test::Refcount;
+
+use Future;
+
+# First done
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->wait_any( $f1, $f2 );
+ is_oneref( $future, '$future has refcount 1 initially' );
+
+ # Two refs; one lexical here, one in $future
+ is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->wait_any' );
+ is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->wait_any' );
+
+ is_deeply( [ $future->pending_futures ],
+ [ $f1, $f2 ],
+ '$future->pending_futures before any ready' );
+
+ is_deeply( [ $future->ready_futures ],
+ [],
+ '$future->done_futures before any ready' );
+
+ my @on_ready_args;
+ $future->on_ready( sub { @on_ready_args = @_ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+ is( scalar @on_ready_args, 0, 'on_ready not yet invoked' );
+
+ $f1->done( one => 1 );
+
+ is_deeply( [ $future->pending_futures ],
+ [],
+ '$future->pending_futures after $f1 ready' );
+
+ is_deeply( [ $future->ready_futures ],
+ [ $f1, $f2 ],
+ '$future->ready_futures after $f1 ready' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f1 ],
+ '$future->done_futures after $f1 ready' );
+
+ is_deeply( [ $future->cancelled_futures ],
+ [ $f2 ],
+ '$future->cancelled_futures after $f1 ready' );
+
+ is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' );
+ identical( $on_ready_args[0], $future, 'Future passed to on_ready' );
+ undef @on_ready_args;
+
+ ok( $future->is_ready, '$future now ready after f1 ready' );
+ is_deeply( [ $future->get ], [ one => 1 ], 'results from $future->get' );
+
+ is_refcount( $future, 1, '$future has refcount 1 at end of test' );
+ undef $future;
+
+ is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' );
+ is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' );
+}
+
+# First fails
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->wait_any( $f1, $f2 );
+
+ $f1->fail( "It fails\n" );
+
+ ok( $future->is_ready, '$future now ready after a failure' );
+
+ is( $future->failure, "It fails\n", '$future->failure yields exception' );
+
+ is( exception { $future->get }, "It fails\n", '$future->get throws exception' );
+
+ ok( $f2->is_cancelled, '$f2 cancelled after a failure' );
+}
+
+# immediately done
+{
+ my $f1 = Future->done;
+
+ my $future = Future->wait_any( $f1 );
+
+ ok( $future->is_ready, '$future of already-ready sub already ready' );
+}
+
+# cancel propagation
+{
+ my $f1 = Future->new;
+ my $c1;
+ $f1->on_cancel( sub { $c1++ } );
+
+ my $future = Future->wait_all( $f1 );
+
+ $future->cancel;
+
+ is( $c1, 1, '$future->cancel marks subs cancelled' );
+}
+
+# cancelled convergent
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->wait_any( $f1, $f2 );
+
+ $f1->cancel;
+
+ ok( !$future->is_ready, '$future not yet ready after first cancellation' );
+
+ $f2->done( "result" );
+
+ ok( $future->is_ready, '$future is ready' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f2 ],
+ '->done_futures with cancellation' );
+ is_deeply( [ $future->cancelled_futures ],
+ [ $f1 ],
+ '->cancelled_futures with cancellation' );
+
+ my $f3 = Future->new;
+ $future = Future->wait_any( $f3 );
+
+ $f3->cancel;
+
+ ok( $future->is_ready, '$future is ready after final cancellation' );
+
+ like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' );
+}
+
+# wait_any on none
+{
+ my $f = Future->wait_any( () );
+
+ ok( $f->is_ready, 'wait_any on no Futures already done' );
+ is( scalar $f->failure, "Cannot ->wait_any with no subfutures",
+ '->get on empty wait_any is empty' );
+}
+
+done_testing;
diff --git a/t/12needs_all.t b/t/12needs_all.t
new file mode 100644
index 0000000..fe9cd36
--- /dev/null
+++ b/t/12needs_all.t
@@ -0,0 +1,147 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Refcount;
+
+use Future;
+
+# All done
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->needs_all( $f1, $f2 );
+ is_oneref( $future, '$future has refcount 1 initially' );
+
+ # Two refs; one lexical here, one in $future
+ is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->needs_all' );
+ is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->needs_all' );
+
+ my $ready;
+ $future->on_ready( sub { $ready++ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+
+ $f1->done( one => 1 );
+ $f2->done( two => 2 );
+
+ is( $ready, 1, '$future is now ready' );
+
+ ok( $future->is_ready, '$future now ready after f2 ready' );
+ is_deeply( [ $future->get ], [ one => 1, two => 2 ], '$future->get after f2 ready' );
+
+ is_refcount( $future, 1, '$future has refcount 1 at end of test' );
+ undef $future;
+
+ is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' );
+ is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' );
+}
+
+# One fails
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+ my $c2;
+ $f2->on_cancel( sub { $c2++ } );
+
+ my $future = Future->needs_all( $f1, $f2 );
+
+ my $ready;
+ $future->on_ready( sub { $ready++ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+
+ $f1->fail( "It fails" );
+
+ is( $ready, 1, '$future is now ready' );
+
+ ok( $future->is_ready, '$future now ready after f1 fails' );
+ is( $future->failure, "It fails", '$future->failure yields exception' );
+ my $file = __FILE__;
+ my $line = __LINE__ + 1;
+ like( exception { $future->get }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->get throws exception' );
+
+ is( $c2, 1, 'Unfinished child future cancelled on failure' );
+
+ is_deeply( [ $future->pending_futures ],
+ [],
+ '$future->pending_futures after $f1 failure' );
+
+ is_deeply( [ $future->ready_futures ],
+ [ $f1, $f2 ],
+ '$future->ready_futures after $f1 failure' );
+
+ is_deeply( [ $future->done_futures ],
+ [],
+ '$future->done_futures after $f1 failure' );
+
+ is_deeply( [ $future->failed_futures ],
+ [ $f1 ],
+ '$future->failed_futures after $f1 failure' );
+
+ is_deeply( [ $future->cancelled_futures ],
+ [ $f2 ],
+ '$future->cancelled_futures after $f1 failure' );
+}
+
+# immediately done
+{
+ my $future = Future->needs_all( Future->done );
+
+ ok( $future->is_ready, '$future of already-done sub already ready' );
+}
+
+# immediately fails
+{
+ my $future = Future->needs_all( Future->fail("F1"), Future->done );
+
+ ok( $future->is_ready, '$future of already-failed sub already ready' );
+}
+
+# cancel propagation
+{
+ my $f1 = Future->new;
+ my $c1;
+ $f1->on_cancel( sub { $c1++ } );
+
+ my $f2 = Future->new;
+ my $c2;
+ $f2->on_cancel( sub { $c2++ } );
+
+ my $future = Future->needs_all( $f1, $f2 );
+
+ $f2->done;
+
+ $future->cancel;
+
+ is( $c1, 1, '$future->cancel marks subs cancelled' );
+ is( $c2, undef, '$future->cancel ignores ready subs' );
+}
+
+# cancelled convergent
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->needs_all( $f1, $f2 );
+
+ $f1->cancel;
+
+ ok( $future->is_ready, '$future of cancelled sub is ready after first cancellation' );
+
+ like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' );
+}
+
+# needs_all on none
+{
+ my $f = Future->needs_all( () );
+
+ ok( $f->is_ready, 'needs_all on no Futures already done' );
+ is_deeply( [ $f->get ], [], '->get on empty needs_all is empty' );
+}
+
+done_testing;
diff --git a/t/13needs_any.t b/t/13needs_any.t
new file mode 100644
index 0000000..b94a762
--- /dev/null
+++ b/t/13needs_any.t
@@ -0,0 +1,200 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Test::Refcount;
+
+use Future;
+
+# One done
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+ my $c2;
+ $f2->on_cancel( sub { $c2++ } );
+
+ my $future = Future->needs_any( $f1, $f2 );
+ is_oneref( $future, '$future has refcount 1 initially' );
+
+ # Two refs; one lexical here, one in $future
+ is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->needs_any' );
+ is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->needs_any' );
+
+ my $ready;
+ $future->on_ready( sub { $ready++ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+
+ $f1->done( one => 1 );
+
+ is( $ready, 1, '$future is now ready' );
+
+ ok( $future->is_ready, '$future now ready after f1 ready' );
+ is_deeply( [ $future->get ], [ one => 1 ], 'results from $future->get' );
+
+ is_deeply( [ $future->pending_futures ],
+ [],
+ '$future->pending_futures after $f1 done' );
+
+ is_deeply( [ $future->ready_futures ],
+ [ $f1, $f2 ],
+ '$future->ready_futures after $f1 done' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f1 ],
+ '$future->done_futures after $f1 done' );
+
+ is_deeply( [ $future->failed_futures ],
+ [],
+ '$future->failed_futures after $f1 done' );
+
+ is_deeply( [ $future->cancelled_futures ],
+ [ $f2 ],
+ '$future->cancelled_futures after $f1 done' );
+
+ is_refcount( $future, 1, '$future has refcount 1 at end of test' );
+ undef $future;
+
+ is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' );
+ is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' );
+
+ is( $c2, 1, 'Unfinished child future cancelled on failure' );
+}
+
+# One fails
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->needs_any( $f1, $f2 );
+
+ my $ready;
+ $future->on_ready( sub { $ready++ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+
+ $f1->fail( "Partly fails" );
+
+ ok( !$future->is_ready, '$future not yet ready after $f1 fails' );
+
+ $f2->done( two => 2 );
+
+ ok( $future->is_ready, '$future now ready after $f2 done' );
+ is_deeply( [ $future->get ], [ two => 2 ], '$future->get after $f2 done' );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f2 ],
+ '$future->done_futures after $f2 done' );
+
+ is_deeply( [ $future->failed_futures ],
+ [ $f1 ],
+ '$future->failed_futures after $f2 done' );
+}
+
+# All fail
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->needs_any( $f1, $f2 );
+
+ my $ready;
+ $future->on_ready( sub { $ready++ } );
+
+ ok( !$future->is_ready, '$future not yet ready' );
+
+ $f1->fail( "Partly fails" );
+
+ $f2->fail( "It fails" );
+
+ is( $ready, 1, '$future is now ready' );
+
+ ok( $future->is_ready, '$future now ready after f2 fails' );
+ is( $future->failure, "It fails", '$future->failure yields exception' );
+ my $file = __FILE__;
+ my $line = __LINE__ + 1;
+ like( exception { $future->get }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->get throws exception' );
+
+ is_deeply( [ $future->failed_futures ],
+ [ $f1, $f2 ],
+ '$future->failed_futures after all fail' );
+}
+
+# immediately done
+{
+ my $future = Future->needs_any( Future->fail("F1"), Future->done );
+
+ ok( $future->is_ready, '$future of already-done sub already ready' );
+}
+
+# immediately fails
+{
+ my $future = Future->needs_any( Future->fail("F1") );
+
+ ok( $future->is_ready, '$future of already-failed sub already ready' );
+ $future->failure;
+}
+
+# cancel propagation
+{
+ my $f1 = Future->new;
+ my $c1;
+ $f1->on_cancel( sub { $c1++ } );
+
+ my $f2 = Future->new;
+ my $c2;
+ $f2->on_cancel( sub { $c2++ } );
+
+ my $future = Future->needs_all( $f1, $f2 );
+
+ $f2->fail( "booo" );
+
+ $future->cancel;
+
+ is( $c1, 1, '$future->cancel marks subs cancelled' );
+ is( $c2, undef, '$future->cancel ignores ready subs' );
+}
+
+# cancelled convergent
+{
+ my $f1 = Future->new;
+ my $f2 = Future->new;
+
+ my $future = Future->needs_any( $f1, $f2 );
+
+ $f1->cancel;
+
+ ok( !$future->is_ready, '$future not yet ready after first cancellation' );
+
+ $f2->done( "result" );
+
+ is_deeply( [ $future->done_futures ],
+ [ $f2 ],
+ '->done_futures with cancellation' );
+ is_deeply( [ $future->cancelled_futures ],
+ [ $f1 ],
+ '->cancelled_futures with cancellation' );
+
+ my $f3 = Future->new;
+ $future = Future->needs_any( $f3 );
+
+ $f3->cancel;
+
+ ok( $future->is_ready, '$future is ready after final cancellation' );
+
+ like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' );
+}
+
+# needs_any on none
+{
+ my $f = Future->needs_any( () );
+
+ ok( $f->is_ready, 'needs_any on no Futures already done' );
+ is( scalar $f->failure, "Cannot ->needs_any with no subfutures",
+ '->get on empty needs_any is empty' );
+}
+
+done_testing;
diff --git a/t/20subclass.t b/t/20subclass.t
new file mode 100644
index 0000000..9d7103d
--- /dev/null
+++ b/t/20subclass.t
@@ -0,0 +1,138 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Identity;
+
+# subclass->...
+{
+ my $f = t::Future::Subclass->new;
+ my @seq;
+
+ isa_ok( $seq[@seq] = $f->then( sub {} ),
+ "t::Future::Subclass",
+ '$f->then' );
+
+ isa_ok( $seq[@seq] = $f->else( sub {} ),
+ "t::Future::Subclass",
+ '$f->and_then' );
+
+ isa_ok( $seq[@seq] = $f->then_with_f( sub {} ),
+ "t::Future::Subclass",
+ '$f->then_with_f' );
+
+ isa_ok( $seq[@seq] = $f->else_with_f( sub {} ),
+ "t::Future::Subclass",
+ '$f->else_with_f' );
+
+ isa_ok( $seq[@seq] = $f->followed_by( sub {} ),
+ "t::Future::Subclass",
+ '$f->followed_by' );
+
+ isa_ok( $seq[@seq] = $f->transform(),
+ "t::Future::Subclass",
+ '$f->transform' );
+
+ $_->cancel for @seq;
+}
+
+# immediate->followed_by( sub { subclass } )
+{
+ my $f = t::Future::Subclass->new;
+ my $seq;
+
+ isa_ok( $seq = Future->done->followed_by( sub { $f } ),
+ "t::Future::Subclass",
+ 'imm->followed_by $f' );
+
+ $seq->cancel;
+}
+
+# convergents
+{
+ my $f = t::Future::Subclass->new;
+ my @seq;
+
+ isa_ok( $seq[@seq] = Future->wait_all( $f ),
+ "t::Future::Subclass",
+ 'Future->wait_all( $f )' );
+
+ isa_ok( $seq[@seq] = Future->wait_any( $f ),
+ "t::Future::Subclass",
+ 'Future->wait_any( $f )' );
+
+ isa_ok( $seq[@seq] = Future->needs_all( $f ),
+ "t::Future::Subclass",
+ 'Future->needs_all( $f )' );
+
+ isa_ok( $seq[@seq] = Future->needs_any( $f ),
+ "t::Future::Subclass",
+ 'Future->needs_any( $f )' );
+
+ my $imm = Future->done;
+
+ isa_ok( $seq[@seq] = Future->wait_all( $imm, $f ),
+ "t::Future::Subclass",
+ 'Future->wait_all( $imm, $f )' );
+
+ # Pick the more derived subclass even if all are pending
+
+ isa_ok( $seq[@seq] = Future->wait_all( Future->new, $f ),
+ "t::Future::Subclass",
+ 'Future->wait_all( Future->new, $f' );
+
+ $_->cancel for @seq;
+}
+
+# empty convergents (RT97537)
+{
+ my $f;
+
+ isa_ok( $f = t::Future::Subclass->wait_all(),
+ "t::Future::Subclass",
+ 'subclass ->wait_all' );
+
+ isa_ok( $f = t::Future::Subclass->wait_any(),
+ "t::Future::Subclass",
+ 'subclass ->wait_any' );
+ $f->failure;
+
+ isa_ok( $f = t::Future::Subclass->needs_all(),
+ "t::Future::Subclass",
+ 'subclass ->needs_all' );
+
+ isa_ok( $f = t::Future::Subclass->needs_any(),
+ "t::Future::Subclass",
+ 'subclass ->needs_any' );
+ $f->failure;
+}
+
+my $f_await;
+{
+ my $f = t::Future::Subclass->new;
+
+ my $count = 0;
+ $f_await = sub {
+ $count++;
+ identical( $_[0], $f, '->await is called on $f' );
+ $_[0]->done( "Result here" ) if $count == 2;
+ };
+
+ is_deeply( [ $f->get ],
+ [ "Result here" ],
+ 'Result from ->get' );
+
+ is( $count, 2, '$f->await called twice' );
+}
+
+done_testing;
+
+package t::Future::Subclass;
+use base qw( Future );
+
+sub await
+{
+ $f_await->( @_ );
+}
diff --git a/t/21debug.t b/t/21debug.t
new file mode 100644
index 0000000..8ad5508
--- /dev/null
+++ b/t/21debug.t
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ $ENV{PERL_FUTURE_DEBUG} = 1;
+}
+
+use Future;
+
+use Time::HiRes qw( gettimeofday tv_interval );
+
+my $LINE;
+my $LOSTLINE;
+
+sub warnings(&)
+{
+ my $code = shift;
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ $code->();
+ $LOSTLINE = __LINE__; return $warnings;
+}
+
+is( warnings {
+ my $f = Future->new;
+ $f->done;
+ }, "", 'Completed Future does not give warning' );
+
+is( warnings {
+ my $f = Future->new;
+ $f->cancel;
+ }, "", 'Cancelled Future does not give warning' );
+
+like( warnings {
+ $LINE = __LINE__; my $f = Future->new;
+ undef $f;
+ },
+ qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) before it was ready\.?$/,
+ 'Lost Future raises a warning' );
+
+my $THENLINE;
+my $SEQLINE;
+like( warnings {
+ $LINE = __LINE__; my $f1 = Future->new;
+ $THENLINE = __LINE__; my $fseq = $f1->then( sub { } ); undef $fseq;
+ $SEQLINE = __LINE__; $f1->done;
+ },
+ qr/^Future=\S+ was constructed at \Q$0\E line $THENLINE and was lost near \Q$0\E line (?:$SEQLINE|$THENLINE) before it was ready\.?
+Future=\S+ \(constructed at \Q$0\E line $LINE\) lost a sequence Future at \Q$0\E line $SEQLINE\.?$/,
+ 'Lost sequence Future raises warning' );
+
+like( warnings {
+ $LINE = __LINE__; my $f = Future->fail("Failed!");
+ undef $f;
+ },
+ qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) with an unreported failure of: Failed!\.?/,
+ 'Destroyed failed future raises warning' );
+
+{
+ local $Future::TIMES = 1;
+
+ my $before = [ gettimeofday ];
+
+ my $future = Future->new;
+
+ ok( defined $future->btime, '$future has btime with $TIMES=1' );
+ ok( tv_interval( $before, $future->btime ) >= 0, '$future btime is not earlier than $before' );
+
+ $future->done;
+
+ ok( defined $future->rtime, '$future has rtime with $TIMES=1' );
+ ok( tv_interval( $future->btime, $future->rtime ) >= 0, '$future rtime is not earlier than btime' );
+ ok( tv_interval( $future->rtime ) >= 0, '$future rtime is not later than now' );
+
+ ok( defined $future->elapsed, '$future has ->elapsed time' );
+ ok( $future->elapsed >= 0, '$future elapsed time >= 0' );
+}
+
+done_testing;
diff --git a/t/22wrap_cb.t b/t/22wrap_cb.t
new file mode 100644
index 0000000..cdd6a59
--- /dev/null
+++ b/t/22wrap_cb.t
@@ -0,0 +1,105 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Future;
+
+our $VAR = "";
+# around Future::wrap_cb => sub { ... }
+{
+ my $orig = Future->can( 'wrap_cb' );
+ no warnings 'redefine';
+ *Future::wrap_cb = sub {
+ my $cb = $orig->(@_);
+ my $saved_VAR = $VAR;
+
+ return sub {
+ local $VAR = $saved_VAR;
+ $cb->(@_);
+ };
+ };
+}
+
+# on_ready
+{
+ my $result;
+ my $f = Future->new;
+
+ {
+ local $VAR = "inner";
+ $f->on_ready( sub { $result = $VAR } );
+ }
+
+ $f->done;
+
+ is( $result, "inner", 'on_ready wraps CB' );
+}
+
+# on_done
+{
+ my $result;
+ my $f = Future->new;
+
+ {
+ local $VAR = "inner";
+ $f->on_done( sub { $result = $VAR } );
+ }
+
+ $f->done;
+
+ is( $result, "inner", 'on_done wraps CB' );
+}
+
+# on_fail
+{
+ my $result;
+ my $f = Future->new;
+
+ {
+ local $VAR = "inner";
+ $f->on_fail( sub { $result = $VAR } );
+ }
+
+ $f->fail( "Failed" );
+
+ is( $result, "inner", 'on_fail wraps CB' );
+}
+
+# then
+{
+ my $result;
+ my $f = Future->new;
+
+ my $f2;
+ {
+ local $VAR = "inner";
+ $f2 = $f->then( sub { $result = $VAR; Future->done } );
+ }
+
+ $f->done;
+
+ is( $result, "inner", 'then wraps CB' );
+}
+
+# else
+{
+ my $result;
+ my $f = Future->new;
+
+ my $f2;
+ {
+ local $VAR = "inner";
+ $f2 = $f->else( sub { $result = $VAR; Future->done } );
+ }
+
+ $f->fail( "Failed" );
+
+ is( $result, "inner", 'else wraps CB' );
+}
+
+# Other sequence methods all use the same ->_sequence so all should be fine
+
+done_testing;
diff --git a/t/30utils-call.t b/t/30utils-call.t
new file mode 100644
index 0000000..221d302
--- /dev/null
+++ b/t/30utils-call.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Identity;
+
+use Future;
+use Future::Utils qw( call );
+
+# call returns future
+{
+ my $ret_f;
+ my $f = call {
+ return $ret_f = Future->new;
+ };
+
+ identical( $f, $ret_f, 'call() returns future returned from its code' );
+ $f->cancel;
+}
+
+# call returns immediate failure on die
+{
+ my $f = call {
+ die "argh!\n";
+ };
+
+ ok( $f->is_ready, 'call() returns immediate future on die' );
+ is( scalar $f->failure, "argh!\n", 'failure from immediate future on die' );
+}
+
+# call returns immediate failure on non-Future return
+{
+ my $f = call {
+ return "non-future";
+ };
+
+ ok( $f->is_ready, 'call() returns immediate future on non-future return' );
+ like( scalar $f->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/,
+ 'failure from immediate future on non-future return' );
+}
+
+done_testing;
diff --git a/t/31utils-call-with-escape.t b/t/31utils-call-with-escape.t
new file mode 100644
index 0000000..973900c
--- /dev/null
+++ b/t/31utils-call-with-escape.t
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Refcount;
+
+use Future;
+use Future::Utils qw( call_with_escape );
+
+# call_with_escape normal return
+{
+ my $ret_f;
+ my $f = call_with_escape {
+ return $ret_f = Future->new;
+ };
+
+ $ret_f->done( "result" );
+
+ ok( $f->is_ready, 'call_with_escape ready after returned future ready' );
+ is( scalar $f->get, "result", 'result of call_with_escape' );
+
+ $f = call_with_escape {
+ return $ret_f = Future->new;
+ };
+
+ $ret_f->fail( "failure" );
+
+ ok( $f->is_ready, 'call_with_escape ready after returned future ready' );
+ is( scalar $f->failure, "failure", 'result of call_with_escape' );
+
+ undef $ret_f;
+ is_oneref( $f, 'call_with_escape has refcount 1 before EOF' );
+}
+
+# call_with_escape synchronous escape
+{
+ my $f = call_with_escape {
+ my $escape = shift;
+ $escape->done( "escaped" );
+ };
+
+ ok( $f->is_ready, 'call_with_escape ready after synchronous escape' );
+ is( scalar $f->get, "escaped", 'result of call_with_escape' );
+}
+
+# call_with_escape delayed escape
+{
+ my $ret_f = Future->new;
+ my $inner_f;
+
+ my $f = call_with_escape {
+ my $escape = shift;
+ return $inner_f = $ret_f->then( sub {
+ return $escape->done( "later escape" );
+ });
+ };
+
+ ok( !$f->is_ready, 'call_with_escape not yet ready before deferral' );
+
+ $ret_f->done;
+
+ ok( $f->is_ready, 'call_with_escape ready after deferral' );
+ is( scalar $f->get, "later escape", 'result of call_with_escape' );
+
+ ok( $inner_f->is_cancelled, 'code-returned future cancelled after escape' );
+}
+
+done_testing;
diff --git a/t/32utils-repeat.t b/t/32utils-repeat.t
new file mode 100644
index 0000000..4ee03ce
--- /dev/null
+++ b/t/32utils-repeat.t
@@ -0,0 +1,188 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Identity;
+
+use Future;
+use Future::Utils qw( repeat try_repeat try_repeat_until_success );
+
+{
+ my $trial_f;
+ my $previous_trial;
+ my $arg;
+ my $again;
+ my $future = repeat {
+ $previous_trial = shift;
+ return $trial_f = Future->new
+ } while => sub { $arg = shift; $again };
+
+ ok( defined $future, '$future defined for repeat while' );
+
+ ok( defined $trial_f, 'An initial future is running' );
+
+ my $first_f = $trial_f;
+
+ $again = 1;
+ $trial_f->done( "one" );
+
+ ok( defined $arg, '$arg defined for while test' );
+ is( scalar $arg->get, "one", '$arg->get for first' );
+
+ identical( $previous_trial, $first_f, 'code block is passed previous trial' );
+
+ $again = 0;
+ $trial_f->done( "two" );
+
+ ok( $future->is_ready, '$future is now ready after second attempt ->done' );
+ is( scalar $future->get, "two", '$future->get' );
+}
+
+# return keyword
+{
+ my $trial_f;
+ my $future = repeat {
+ return $trial_f = Future->new
+ } while => sub { 1 }, return => my $ret = Future->new;
+
+ identical( $future, $ret, 'repeat with return yields correct instance' );
+}
+
+# cancellation
+{
+ my @running; my $i = 0;
+ my $future = repeat {
+ return $running[$i++] = Future->new
+ } while => sub { 1 };
+
+ ok( defined $future, '$future defined for repeat while' );
+
+ ok( defined $running[0], 'An initial future is running' );
+
+ $running[0]->done;
+
+ $future->cancel;
+
+ ok( !$running[0]->is_cancelled, 'previously running future not cancelled' );
+ ok( $running[1]->is_cancelled, 'running future cancelled after eventual is cancelled' );
+ ok( !$running[2], 'a third trial is not started' );
+}
+
+# until
+{
+ my $trial_f;
+ my $arg;
+ my $accept;
+ my $future = repeat {
+ return $trial_f = Future->new
+ } until => sub { $arg = shift; $accept };
+
+ ok( defined $future, '$future defined for repeat until' );
+
+ ok( defined $trial_f, 'An initial future is running' );
+
+ $accept = 0;
+ $trial_f->done( "three" );
+
+ ok( defined $arg, '$arg defined for while test' );
+ is( scalar $arg->get, "three", '$arg->get for first' );
+
+ $accept = 1;
+ $trial_f->done( "four" );
+
+ ok( $future->is_ready, '$future is now ready after second attempt ->done' );
+ is( scalar $future->get, "four", '$future->get' );
+}
+
+# body code dies
+{
+ my $future;
+
+ $future = repeat {
+ die "It failed\n";
+ } while => sub { !shift->failure };
+
+ is( $future->failure, "It failed\n", 'repeat while failure after code exception' );
+
+ $future = repeat {
+ die "It failed\n";
+ } until => sub { shift->failure };
+
+ is( $future->failure, "It failed\n", 'repeat until failure after code exception' );
+}
+
+# condition code dies (RT100067)
+{
+ my $future = repeat {
+ Future->done(1);
+ } while => sub { die "it dies!\n" };
+
+ is( $future->failure, "it dies!\n", 'repeat while failure after condition exception' );
+}
+
+# Non-Future return fails
+{
+ my $future;
+
+ $future = repeat {
+ "non-Future"
+ } while => sub { !shift->failure };
+
+ like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/,
+ 'repeat failure for non-Future return' );
+}
+
+# try_repeat catches failures
+{
+ my $attempt = 0;
+ my $future = try_repeat {
+ if( ++$attempt < 3 ) {
+ return FUture->new->fail( "Too low" );
+ }
+ else {
+ return Future->done( $attempt );
+ }
+ } while => sub { shift->failure };
+
+ ok( $future->is_ready, '$future is now ready for try_repeat' );
+ is( scalar $future->get, 3, '$future->get' );
+}
+
+{
+ my $attempt = 0;
+ my $future = try_repeat_until_success {
+ if( ++$attempt < 3 ) {
+ return Future->fail( "Too low" );
+ }
+ else {
+ return Future->done( $attempt );
+ }
+ };
+
+ ok( $future->is_ready, '$future is now ready for try_repeat_until_success' );
+ is( scalar $future->get, 3, '$future->get' );
+}
+
+# repeat prints a warning if asked to retry a failure
+{
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
+
+ my $attempt = 0;
+ my $future = repeat {
+ if( ++$attempt < 3 ) {
+ return Future->fail( "try again" );
+ }
+ else {
+ return Future->done( "OK" );
+ }
+ } while => sub { $_[0]->failure };
+
+ ok( $future->is_ready, '$future is now ready after repeat retries failures' );
+ like( $warnings, qr/(?:^Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead at \Q$0\E line \d+\.?$)+/m,
+ 'Warnings printing by repeat retries failures' );
+}
+
+done_testing;
diff --git a/t/33utils-repeat-generate.t b/t/33utils-repeat-generate.t
new file mode 100644
index 0000000..72410fb
--- /dev/null
+++ b/t/33utils-repeat-generate.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Future;
+use Future::Utils qw( repeat );
+
+# generate without otherwise
+{
+ my $trial_f;
+ my $arg;
+
+ my $i = 0;
+ my $future = repeat {
+ $arg = shift;
+ return $trial_f = Future->new;
+ } generate => sub { $i < 3 ? ++$i : () };
+
+ is( $arg, 1, '$arg 1 for first iteration' );
+ $trial_f->done;
+
+ ok( !$future->is_ready, '$future not ready' );
+
+ is( $arg, 2, '$arg 2 for second iteratoin' );
+ $trial_f->done( "not yet" );
+
+ ok( !$future->is_ready, '$future still not ready' );
+
+ is( $arg, 3, '$arg 3 for third iteration' );
+ $trial_f->done( "result" );
+
+ ok( $future->is_ready, '$future now ready' );
+ is( scalar $future->get, "result", '$future->get' );
+}
+
+# generate otherwise
+{
+ my $last_trial_f;
+ my $i = 0;
+ my $future = repeat {
+ Future->done( "ignore me $_[0]" );
+ } generate => sub { $i < 3 ? ++$i : () },
+ otherwise => sub {
+ $last_trial_f = shift;
+ return Future->fail( "Nothing succeeded\n" );
+ };
+
+ is( scalar $future->failure, "Nothing succeeded\n", '$future returns otherwise failure' );
+ is( scalar $last_trial_f->get, "ignore me 3", '$last_trial_f->get' );
+
+ $future = repeat {
+ Future->done( "ignore me" );
+ } generate => sub { () },
+ otherwise => sub { Future->fail( "Nothing to do\n" ) };
+
+ is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty generator' );
+}
+
+# Probably don't need much more testing since most combinations are test with
+# foreach - while/until, die, etc..
+
+done_testing;
diff --git a/t/34utils-repeat-foreach.t b/t/34utils-repeat-foreach.t
new file mode 100644
index 0000000..94d70d6
--- /dev/null
+++ b/t/34utils-repeat-foreach.t
@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Future;
+use Future::Utils qw( repeat try_repeat try_repeat_until_success );
+
+# foreach without otherwise
+{
+ my $trial_f;
+ my $arg;
+ my $future = repeat {
+ $arg = shift;
+ return $trial_f = Future->new;
+ } foreach => [qw( one two three )];
+
+ is( $arg, "one", '$arg one for first iteration' );
+ $trial_f->done;
+
+ ok( !$future->is_ready, '$future not ready' );
+
+ is( $arg, "two", '$arg two for second iteration' );
+ $trial_f->done( "another" );
+
+ ok( !$future->is_ready, '$future not ready' );
+
+ is( $arg, "three", '$arg three for third iteration' );
+ $trial_f->done( "result" );
+
+ ok( $future->is_ready, '$future now ready' );
+ is( scalar $future->get, "result", '$future->get' );
+}
+
+# foreach otherwise
+{
+ my $last_trial_f;
+ my $future = repeat {
+ Future->done( "ignore me $_[0]" );
+ } foreach => [qw( one two three )],
+ otherwise => sub {
+ $last_trial_f = shift;
+ return Future->fail( "Nothing succeeded\n" );
+ };
+
+ is( scalar $future->failure, "Nothing succeeded\n", '$future returns otherwise failure' );
+ is( scalar $last_trial_f->get, "ignore me three", '$last_trial_f->get' );
+
+ $future = repeat {
+ Future->done( "ignore me" );
+ } foreach => [],
+ otherwise => sub { Future->fail( "Nothing to do\n" ) };
+
+ is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty list' );
+}
+
+# foreach on empty list
+{
+ my $future = repeat { die "Not invoked" } foreach => [];
+
+ ok( $future->is_ready, 'repeat {} on empty foreach without otherwise already ready' );
+ is_deeply( [ $future->get ], [], 'Result of empty future' );
+
+ $future = repeat { die "Not invoked" } foreach => [],
+ otherwise => sub { Future->done( 1, 2, 3 ) };
+
+ ok( $future->is_ready, 'repeat {} on empty foreach with otherwise already ready' );
+ is_deeply( [ $future->get ], [ 1, 2, 3 ], 'Result of otherwise future' );
+}
+
+# foreach while
+{
+ my $future = try_repeat {
+ my $arg = shift;
+ if( $arg eq "bad" ) {
+ return Future->fail( "bad" );
+ }
+ else {
+ return Future->done( $arg );
+ }
+ } foreach => [qw( bad good not-attempted )],
+ while => sub { shift->failure };
+
+ is( scalar $future->get, "good", '$future->get returns correct result for foreach+while' );
+}
+
+# foreach until
+{
+ my $future = try_repeat {
+ my $arg = shift;
+ if( $arg eq "bad" ) {
+ return Future->fail( "bad" );
+ }
+ else {
+ return Future->done( $arg );
+ }
+ } foreach => [qw( bad good not-attempted )],
+ until => sub { !shift->failure };
+
+ is( scalar $future->get, "good", '$future->get returns correct result for foreach+until' );
+}
+
+# foreach while + otherwise
+{
+ my $future = repeat {
+ Future->done( $_[0] );
+ } foreach => [ 1, 2, 3 ],
+ while => sub { $_[0]->get < 2 },
+ otherwise => sub { Future->fail( "Failed to find 2" ) };
+
+ is( scalar $future->get, 2, '$future->get returns successful result from while + otherwise' );
+}
+
+# try_repeat_until_success foreach
+{
+ my $future = try_repeat_until_success {
+ my $arg = shift;
+ if( $arg eq "bad" ) {
+ return Future->fail( "bad" );
+ }
+ else {
+ return Future->done( $arg );
+ }
+ } foreach => [qw( bad good not-attempted )];
+
+ is( scalar $future->get, "good", '$future->get returns correct result for try_repeat_until_success' );
+}
+
+# main code dies
+{
+ my $future = try_repeat {
+ $_[1]->failure if @_ > 1; # absorb the previous failure
+
+ die "It failed\n";
+ } foreach => [ 1, 2, 3 ];
+
+ is( $future->failure, "It failed\n", 'repeat foreach failure after code exception' );
+}
+
+# otherwise code dies
+{
+ my $future = repeat {
+ Future->done;
+ } foreach => [],
+ otherwise => sub { die "It failed finally\n" };
+
+ is( $future->failure, "It failed finally\n", 'repeat foreach failure after otherwise exception' );
+}
+
+done_testing;
diff --git a/t/35utils-map-void.t b/t/35utils-map-void.t
new file mode 100644
index 0000000..3f62e5f
--- /dev/null
+++ b/t/35utils-map-void.t
@@ -0,0 +1,200 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Identity;
+
+use Future;
+use Future::Utils qw( fmap_void );
+
+# fmap_void from ARRAY, no concurrency
+{
+ my @subf;
+ my $future = fmap_void {
+ return $subf[$_[0]] = Future->new
+ } foreach => [ 0 .. 2 ];
+
+ ok( defined $future, '$future defined for fmap non-concurrent' );
+
+ ok( defined $subf[0], '$subf[0] defined' );
+ ok( !defined $subf[1], '$subf[1] not yet defined' );
+
+ $subf[0]->done;
+
+ ok( defined $subf[1], '$subf[1] defined after $subf[0] done' );
+
+ $subf[1]->done;
+
+ $subf[2]->done;
+
+ ok( $future->is_ready, '$future now ready after subs done' );
+ is_deeply( [ $future->get ], [], '$future->get empty for fmap_void' );
+}
+
+# fmap_void from CODE
+{
+ my @subf;
+ my $future = fmap_void {
+ return $subf[$_[0]] = Future->new
+ } generate => do { my $count = 0;
+ sub { return unless $count < 3; $count++ } };
+
+ ok( defined $future, '$future defined for fmap non-concurrent from CODE' );
+
+ ok( defined $subf[0], '$subf[0] defined' );
+
+ $subf[0]->done;
+ $subf[1]->done;
+ $subf[2]->done;
+
+ ok( $future->is_ready, '$future now ready after subs done from CODE' );
+}
+
+# fmap_void concurrent
+{
+ my @subf;
+ my $future = fmap_void {
+ return $subf[$_[0]] = Future->new
+ } foreach => [ 0 .. 4 ],
+ concurrent => 2;
+
+ ok( defined $future, '$future defined for fmap concurrent=2' );
+
+ ok( defined $subf[0], '$subf[0] defined' );
+ ok( defined $subf[1], '$subf[1] defined' );
+
+ $subf[0]->done; $subf[1]->done;
+
+ ok( defined $subf[2], '$subf[2] defined' );
+ ok( defined $subf[3], '$subf[3] defined' );
+
+ $subf[2]->done; $subf[3]->done;
+
+ ok( defined $subf[4], '$subf[4] deifned' );
+ ok( !$future->is_ready, '$future not yet ready while one sub remains' );
+
+ $subf[4]->done;
+
+ ok( $future->is_ready, '$future now ready after concurrent subs done' );
+}
+
+# fmap_void late-addition concurrently
+{
+ my @items = ( 1, 2, 3 );
+ my @subf;
+ my $future = fmap_void {
+ my $val = shift;
+ my $f = $subf[$val] = Future->new;
+ $f->on_done( sub { push @items, 4, 5, 6 } ) if $val == 3;
+ $f
+ } foreach => \@items,
+ concurrent => 4;
+
+ ok( defined $future, '$future defined for fmap concurrent=3 late-add' );
+
+ ok( $subf[1] && $subf[2] && $subf[3], '3 subfutures initally ready' );
+
+ $subf[1]->done;
+ $subf[2]->done;
+
+ ok( !$subf[4], 'No $subf[4] before $subf[3] done' );
+
+ $subf[3]->done;
+
+ ok( $subf[4] && $subf[5] && $subf[6], '3 new subfutures now ready' );
+
+ $subf[4]->done;
+ $subf[5]->done;
+ $subf[6]->done;
+
+ ok( $future->is_ready, '$future now ready after all 6 subfutures done' );
+}
+
+# fmap_void on immediates
+{
+ my $future = fmap_void {
+ return Future->done
+ } foreach => [ 0 .. 2 ];
+
+ ok( $future->is_ready, '$future already ready for fmap on immediates' );
+}
+
+# fmap_void on non/immediate mix
+{
+ my @item_f = ( my $item = Future->new, Future->done, Future->done );
+ my $future = fmap_void {
+ return $_[0];
+ } foreach => \@item_f,
+ concurrent => 2;
+
+ ok( !$future->is_ready, '$future not yet ready before non-immediate done' );
+
+ $item->done;
+ ok( $future->is_ready, '$future now ready after non-immediate done' );
+}
+
+# fmap_void fail
+{
+ my @subf;
+ my $future = fmap_void {
+ return $subf[$_[0]] = Future->new;
+ } foreach => [ 0, 1, 2 ],
+ concurrent => 2;
+
+ ok( !$subf[0]->is_cancelled, '$subf[0] not cancelled before failure' );
+
+ $subf[1]->fail( "failure" );
+
+ ok( $subf[0]->is_cancelled, '$subf[0] now cancelled after $subf[1] failure' );
+ ok( $future->is_ready, '$future now ready after $sub[1] failure' );
+ is( scalar $future->failure, "failure", '$future->failure after $sub[1] failure' );
+ ok( !defined $subf[2], '$subf[2] was never started after $subf[1] failure' );
+}
+
+# fmap_void immediate fail
+{
+ my @subf;
+ my $future = fmap_void {
+ if( $_[0] eq "fail" ) {
+ return Future->fail( "failure" );
+ }
+ else {
+ $subf[$_[0]] = Future->new;
+ }
+ } foreach => [ 0, "fail", 2 ],
+ concurrent => 3;
+
+ ok( $future->is_ready, '$future is already ready' );
+ is( scalar $future->failure, "failure", '$future->failure after immediate failure' );
+
+ ok( $subf[0]->is_cancelled, '$subf[0] is cancelled after immediate failure' );
+ ok( !defined $subf[2], '$subf[2] was never started after immediate failure' );
+}
+
+# fmap_void cancel
+{
+ my @subf;
+ my $future = fmap_void {
+ return $subf[$_[0]] = Future->new;
+ } foreach => [ 0, 1, 2 ],
+ concurrent => 2;
+
+ $future->cancel;
+
+ ok( $subf[0]->is_cancelled, '$subf[0] now cancelled after ->cancel' );
+ ok( $subf[1]->is_cancelled, '$subf[1] now cancelled after ->cancel' );
+ ok( !defined $subf[2], '$subf[2] was never started after ->cancel' );
+}
+
+# fmap_void return
+{
+ my $future = fmap_void {
+ return Future->done;
+ } foreach => [ 0 ], return => my $ret = Future->new;
+
+ identical( $future, $ret, 'repeat with return yields correct instance' );
+}
+
+done_testing;
diff --git a/t/36utils-map.t b/t/36utils-map.t
new file mode 100644
index 0000000..a19c43c
--- /dev/null
+++ b/t/36utils-map.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Future;
+use Future::Utils qw( fmap_concat fmap_scalar );
+
+# fmap_concat no concurrency
+{
+ my @subf;
+ my $future = fmap_concat {
+ return $subf[$_[0]] = Future->new
+ } foreach => [ 0 .. 2 ];
+
+ my @results;
+ $future->on_done( sub { @results = @_ });
+
+ $subf[0]->done( "A", "B" );
+ $subf[1]->done( "C", "D", );
+ $subf[2]->done( "E" );
+
+ ok( $future->is_ready, '$future now ready after subs done for fmap_concat' );
+ is_deeply( [ $future->get ], [qw( A B C D E )], '$future->get for fmap_concat' );
+ is_deeply( \@results, [qw( A B C D E )], '@results for fmap_concat' );
+}
+
+# fmap_concat concurrent
+{
+ my @subf;
+ my $future = fmap_concat {
+ return $subf[$_[0]] = Future->new
+ } foreach => [ 0 .. 2 ],
+ concurrent => 3;
+
+ # complete out of order
+ $subf[0]->done( "A", "B" );
+ $subf[2]->done( "E" );
+ $subf[1]->done( "C", "D" );
+
+ is_deeply( [ $future->get ], [qw( A B C D E )], '$future->get for fmap_concat out of order' );
+}
+
+# fmap_scalar no concurrency
+{
+ my @subf;
+ my $future = fmap_scalar {
+ return $subf[$_[0]] = Future->new
+ } foreach => [ 0 .. 2 ];
+
+ my @results;
+ $future->on_done( sub { @results = @_ });
+
+ $subf[0]->done( "A" );
+ $subf[1]->done( "B" );
+ $subf[2]->done( "C" );
+
+ ok( $future->is_ready, '$future now ready after subs done for fmap_scalar' );
+ is_deeply( [ $future->get ], [qw( A B C )], '$future->get for fmap_scalar' );
+ is_deeply( \@results, [qw( A B C )], '@results for fmap_scalar' );
+}
+
+done_testing;
diff --git a/t/50test-future.t b/t/50test-future.t
new file mode 100644
index 0000000..326066e
--- /dev/null
+++ b/t/50test-future.t
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Refcount;
+use Test::Builder::Tester;
+
+use Future;
+use Test::Future;
+
+# pass
+{
+ test_out( "ok 1 - immediate Future" );
+
+ my $ran_code;
+ no_pending_futures {
+ $ran_code++;
+ Future->done(1,2,3);
+ } 'immediate Future';
+
+ test_test( "immediate Future passes" );
+ ok( $ran_code, 'actually ran the code' );
+}
+
+# fail
+{
+ test_out( "not ok 1 - pending Future" );
+ test_fail( +8 );
+ test_err( "# The following Futures are still pending:" );
+ test_err( qr/^# 0x[0-9a-f]+\n/ );
+ test_err( qr/^# Writing heap dump to \S+\n/ ) if Test::Future::HAVE_DEVEL_MAT_DUMPER;
+
+ my $f;
+ no_pending_futures {
+ $f = Future->new;
+ } 'pending Future';
+
+ test_test( "pending Future fails" );
+
+ $f->cancel;
+}
+
+# does not retain Futures
+{
+ test_out( "ok 1 - refcount 2 before drop" );
+ test_out( "ok 2 - refcount 1 after drop" );
+ test_out( "ok 3 - retain" );
+
+ no_pending_futures {
+ my $arr = [1,2,3];
+ my $f = Future->new;
+ $f->done( $arr );
+ is_refcount( $arr, 2, 'refcount 2 before drop' );
+ undef $f;
+ is_refcount( $arr, 1, 'refcount 1 after drop' );
+ } 'retain';
+
+ test_test( "no_pending_futures does not retain completed Futures" );
+}
+
+# does not retain immedate Futures
+{
+ test_out( "ok 1 - refcount 2 before drop" );
+ test_out( "ok 2 - refcount 1 after drop" );
+ test_out( "ok 3 - retain" );
+
+ no_pending_futures {
+ my $arr = [1,2,3];
+ my $f = Future->done( $arr );
+ is_refcount( $arr, 2, 'refcount 2 before drop' );
+ undef $f;
+ is_refcount( $arr, 1, 'refcount 1 after drop' );
+ } 'retain';
+
+ test_test( "no_pending_futures does not retain immediate Futures" );
+}
+
+END {
+ # Clean up Devel::MAT dumpfile
+ my $pmat = $0;
+ $pmat =~ s/\.t$/-1.pmat/;
+ unlink $pmat if -f $pmat;
+}
+
+done_testing;
diff --git a/t/99pod.t b/t/99pod.t
new file mode 100644
index 0000000..eb319fb
--- /dev/null
+++ b/t/99pod.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok();