1 files changed, 138 insertions, 0 deletions
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->( @_ );
+}