#!/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->( @_ );
}