1#!/usr/bin/perl
2
3use v5.10;
4use strict;
5use warnings;
6
7use Test::More;
8use Test::Identity;
9
10# subclass->...
11{
12   my $f = t::Future::Subclass->new;
13   my @seq;
14
15   isa_ok( $seq[@seq] = $f->then( sub {} ),
16           "t::Future::Subclass",
17           '$f->then' );
18
19   isa_ok( $seq[@seq] = $f->else( sub {} ),
20           "t::Future::Subclass",
21           '$f->and_then' );
22
23   isa_ok( $seq[@seq] = $f->then_with_f( sub {} ),
24           "t::Future::Subclass",
25           '$f->then_with_f' );
26
27   isa_ok( $seq[@seq] = $f->else_with_f( sub {} ),
28           "t::Future::Subclass",
29           '$f->else_with_f' );
30
31   isa_ok( $seq[@seq] = $f->followed_by( sub {} ),
32           "t::Future::Subclass",
33           '$f->followed_by' );
34
35   isa_ok( $seq[@seq] = $f->transform(),
36           "t::Future::Subclass",
37           '$f->transform' );
38
39   $_->cancel for @seq;
40}
41
42# immediate subclass->...
43{
44   my $fdone = t::Future::Subclass->new->done;
45   my $ffail = t::Future::Subclass->new->fail( "Oop\n" );
46
47   isa_ok( $fdone->then( sub { 1 } ),
48           "t::Future::Subclass",
49           'immediate $f->then' );
50
51   isa_ok( $ffail->else( sub { 1 } ),
52           "t::Future::Subclass",
53           'immediate $f->else' );
54
55   isa_ok( $fdone->then_with_f( sub {} ),
56           "t::Future::Subclass",
57           'immediate $f->then_with_f' );
58
59   isa_ok( $ffail->else_with_f( sub {} ),
60           "t::Future::Subclass",
61           'immediate $f->else_with_f' );
62
63   isa_ok( $fdone->followed_by( sub {} ),
64           "t::Future::Subclass",
65           '$f->followed_by' );
66}
67
68# immediate->followed_by( sub { subclass } )
69{
70   my $f = t::Future::Subclass->new;
71   my $seq;
72
73   isa_ok( $seq = Future->done->followed_by( sub { $f } ),
74           "t::Future::Subclass",
75           'imm->followed_by $f' );
76
77   $seq->cancel;
78}
79
80# convergents
81{
82   my $f = t::Future::Subclass->new;
83   my @seq;
84
85   isa_ok( $seq[@seq] = Future->wait_all( $f ),
86           "t::Future::Subclass",
87           'Future->wait_all( $f )' );
88
89   isa_ok( $seq[@seq] = Future->wait_any( $f ),
90           "t::Future::Subclass",
91           'Future->wait_any( $f )' );
92
93   isa_ok( $seq[@seq] = Future->needs_all( $f ),
94           "t::Future::Subclass",
95           'Future->needs_all( $f )' );
96
97   isa_ok( $seq[@seq] = Future->needs_any( $f ),
98           "t::Future::Subclass",
99           'Future->needs_any( $f )' );
100
101   my $imm = Future->done;
102
103   isa_ok( $seq[@seq] = Future->wait_all( $imm, $f ),
104           "t::Future::Subclass",
105           'Future->wait_all( $imm, $f )' );
106
107   # Pick the more derived subclass even if all are pending
108
109   isa_ok( $seq[@seq] = Future->wait_all( Future->new, $f ),
110           "t::Future::Subclass",
111           'Future->wait_all( Future->new, $f' );
112
113   $_->cancel for @seq;
114}
115
116# empty convergents (RT97537)
117{
118   my $f;
119
120   isa_ok( $f = t::Future::Subclass->wait_all(),
121           "t::Future::Subclass",
122           'subclass ->wait_all' );
123
124   isa_ok( $f = t::Future::Subclass->wait_any(),
125           "t::Future::Subclass",
126           'subclass ->wait_any' );
127   $f->failure;
128
129   isa_ok( $f = t::Future::Subclass->needs_all(),
130           "t::Future::Subclass",
131           'subclass ->needs_all' );
132
133   isa_ok( $f = t::Future::Subclass->needs_any(),
134           "t::Future::Subclass",
135           'subclass ->needs_any' );
136   $f->failure;
137}
138
139# ->get calls the correct await
140{
141   my $f = t::Future::Subclass->new;
142
143   my $called;
144   no warnings 'once';
145   local *t::Future::Subclass::await = sub {
146      $called++;
147      identical( $_[0], $f, '->await is called on $f' );
148      $_[0]->done( "Result here" );
149   };
150
151   is_deeply( [ $f->get ],
152              [ "Result here" ],
153              'Result from ->get' );
154
155   ok( $called, '$f->await called' );
156}
157
158done_testing;
159
160package t::Future::Subclass;
161use base qw( Future );
162