1 files changed, 141 insertions, 0 deletions
diff --git a/lib/Test/Future.pm b/lib/Test/Future.pm
new file mode 100644
index 0000000..f2a7d5f
--- /dev/null
+++ b/lib/Test/Future.pm
@@ -0,0 +1,141 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2014 -- leonerd@leonerd.org.uk
+
+package Test::Future;
+
+use strict;
+use warnings;
+use base qw( Test::Builder::Module );
+
+our $VERSION = '0.32';
+
+our @EXPORT = qw(
+   no_pending_futures
+);
+
+use Scalar::Util qw( refaddr );
+
+use constant HAVE_DEVEL_MAT_DUMPER => defined eval { require Devel::MAT::Dumper };
+
+=head1 NAME
+
+C<Test::Future> - unit test assertions for L<Future> instances
+
+=head1 SYNOPSIS
+
+ use Test::More tests => 2;
+ use Test::Future;
+
+ no_pending_futures {
+    my $f = some_function();
+
+    is( $f->get, "result", 'Result of the some_function()' );
+ } 'some_function() leaves no pending Futures';
+
+=head1 DESCRIPTION
+
+This module provides unit testing assertions that may be useful when testing
+code based on, or using L<Future> instances or subclasses.
+
+=cut
+
+=head1 FUNCTIONS
+
+=cut
+
+=head2 no_pending_futures( \&code, $name )
+
+Runs the given block of code, while keeping track of every C<Future> instance
+constructed while doing so. After the code has returned, each of these
+instances are inspected to check that they are not still pending. If they are
+all either ready (by success or failure) or cancelled, the test will pass. If
+any are still pending then the test fails.
+
+If L<Devel::MAT> is installed, it will be used to write a memory state dump
+after a failure. It will create a F<.pmat> file named the same as the unit
+test, but with the trailing F<.t> suffix replaced with F<-TEST.pmat> where
+C<TEST> is the number of the test that failed (in case there was more than
+one). A list of addresses of C<Future> instances that are still pending is
+also printed to assist in debugging the issue.
+
+It is not an error if the code does not construct any C<Future> instances at
+all. The block of code may contain other testing assertions; they will be run
+before the assertion by C<no_pending_futures> itself.
+
+=cut
+
+sub no_pending_futures(&@)
+{
+   my ( $code, $name ) = @_;
+
+   my @futures;
+
+   no warnings 'redefine';
+
+   my $new = Future->can( "new" );
+   local *Future::new = sub {
+      my $f = $new->(@_);
+      push @futures, $f;
+      $f->on_ready( sub {
+         my $f = shift;
+         for ( 0 .. $#futures ) {
+            refaddr( $futures[$_] ) == refaddr( $f ) or next;
+
+            splice @futures, $_, 1, ();
+            return;
+         }
+      });
+      return $f;
+   };
+
+   my $done = Future->can( "done" );
+   local *Future::done = sub {
+      my $f = $done->(@_);
+      pop @futures if !ref $_[0]; # class method
+      return $f;
+   };
+
+   my $fail = Future->can( "fail" );
+   local *Future::fail = sub {
+      my $f = $fail->(@_);
+      pop @futures if !ref $_[0]; # class method
+      return $f;
+   };
+
+   my $tb = __PACKAGE__->builder;
+
+   $code->();
+
+   my @pending = grep { !$_->is_ready } @futures;
+
+   return $tb->ok( 1, $name ) if !@pending;
+
+   my $ok = $tb->ok( 0, $name );
+
+   $tb->diag( "The following Futures are still pending:" );
+   $tb->diag( join ", ", map { sprintf "0x%x", refaddr $_ } @pending );
+
+   if( HAVE_DEVEL_MAT_DUMPER ) {
+      my $file = $0;
+      my $num = $tb->current_test;
+
+      # Trim the .t off first then append -$num.pmat, in case $0 wasn't a .t file
+      $file =~ s/\.(?:t|pm|pl)$//;
+      $file .= "-$num.pmat";
+
+      $tb->diag( "Writing heap dump to $file" );
+      Devel::MAT::Dumper::dump( $file );
+   }
+
+   return $ok;
+}
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;