1#!/usr/bin/perl
2
3use v5.10;
4use strict;
5use warnings;
6
7use Test::More;
8use Test::Fatal;
9use Test::Identity;
10use Test::Refcount;
11
12use Future;
13
14# done
15{
16   my $future = Future->new;
17
18   ok( defined $future, '$future defined' );
19   isa_ok( $future, "Future", '$future' );
20   is_oneref( $future, '$future has refcount 1 initially' );
21
22   ok( !$future->is_ready, '$future not yet ready' );
23   is( $future->state, "pending", '$future->state before done' );
24
25   my @on_ready_args;
26   identical( $future->on_ready( sub { @on_ready_args = @_ } ), $future, '->on_ready returns $future' );
27
28   my @on_done_args;
29   identical( $future->on_done( sub { @on_done_args = @_ } ), $future, '->on_done returns $future' );
30   identical( $future->on_fail( sub { die "on_fail called for done future" } ), $future, '->on_fail returns $future' );
31
32   identical( $future->done( result => "here" ), $future, '->done returns $future' );
33
34   is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' );
35   identical( $on_ready_args[0], $future, 'Future passed to on_ready' );
36   undef @on_ready_args;
37
38   is_deeply( \@on_done_args, [ result => "here" ], 'Results passed to on_done' );
39
40   ok( $future->is_ready, '$future is now ready' );
41   ok( $future->is_done, '$future is done' );
42   ok( !$future->is_failed, '$future is not failed' );
43   is( $future->state, "done", '$future->state after done' );
44   is_deeply( [ $future->result ], [ result => "here" ], 'Results from $future->result' );
45   is( scalar $future->result, "result", 'Result from scalar $future->result' );
46
47   is_oneref( $future, '$future has refcount 1 at end of test' );
48}
49
50# wrap
51{
52   my $f = Future->new;
53
54   my $future = Future->wrap( $f );
55
56   ok( defined $future, 'Future->wrap(Future) defined' );
57   isa_ok( $future, "Future", 'Future->wrap(Future)' );
58
59   $f->done( "Wrapped Future" );
60   is( scalar $future->result, "Wrapped Future", 'Future->wrap(Future)->result' );
61
62   $future = Future->wrap( "Plain string" );
63
64   ok( defined $future, 'Future->wrap(string) defined' );
65   isa_ok( $future, "Future", 'Future->wrap(string)' );
66
67   is( scalar $future->result, "Plain string", 'Future->wrap(string)->result' );
68}
69
70# done chaining
71{
72   my $future = Future->new;
73
74   my $f1 = Future->new;
75   my $f2 = Future->new;
76
77   $future->on_done( $f1 );
78   $future->on_ready( $f2 );
79
80   my @on_done_args_1;
81   $f1->on_done( sub { @on_done_args_1 = @_ } );
82   my @on_done_args_2;
83   $f2->on_done( sub { @on_done_args_2 = @_ } );
84
85   $future->done( chained => "result" );
86
87   is_deeply( \@on_done_args_1, [ chained => "result" ], 'Results chained via ->on_done( $f )' );
88   is_deeply( \@on_done_args_2, [ chained => "result" ], 'Results chained via ->on_ready( $f )' );
89}
90
91# immediately done
92{
93   my $future = Future->done( already => "done" );
94
95   my @on_done_args;
96   identical( $future->on_done( sub { @on_done_args = @_; } ), $future, '->on_done returns future for immediate' );
97   my $on_fail;
98   identical( $future->on_fail( sub { $on_fail++; } ), $future, '->on_fail returns future for immediate' );
99
100   is_deeply( \@on_done_args, [ already => "done" ], 'Results passed to on_done for immediate future' );
101   ok( !$on_fail, 'on_fail not invoked for immediate future' );
102
103   my $f1 = Future->new;
104   my $f2 = Future->new;
105
106   $future->on_done( $f1 );
107   $future->on_ready( $f2 );
108
109   ok( $f1->is_ready, 'Chained ->on_done for immediate future' );
110   ok( $f1->is_done, 'Chained ->on_done is done for immediate future' );
111   is_deeply( [ $f1->result ], [ already => "done" ], 'Results from chained via ->on_done for immediate future' );
112   ok( $f2->is_ready, 'Chained ->on_ready for immediate future' );
113   ok( $f2->is_done, 'Chained ->on_ready is done for immediate future' );
114   is_deeply( [ $f2->result ], [ already => "done" ], 'Results from chained via ->on_ready for immediate future' );
115}
116
117# fail
118{
119   my $future = Future->new;
120
121   $future->on_done( sub { die "on_done called for failed future" } );
122   my $failure;
123   $future->on_fail( sub { ( $failure ) = @_; } );
124
125   identical( $future->fail( "Something broke" ), $future, '->fail returns $future' );
126
127   ok( $future->is_ready, '$future->fail marks future ready' );
128   ok( !$future->is_done, '$future->fail does not mark future done' );
129   ok( $future->is_failed, '$future->fail marks future as failed' );
130   is( $future->state, "failed", '$future->state after fail' );
131
132   is( scalar $future->failure, "Something broke", '$future->failure yields exception' );
133   my $file = __FILE__;
134   my $line = __LINE__ + 1;
135   like( exception { $future->result }, qr/^Something broke at \Q$file line $line\E\.?\n$/, '$future->result throws exception' );
136
137   is( $failure, "Something broke", 'Exception passed to on_fail' );
138}
139
140{
141   my $future = Future->new;
142
143   $future->fail( "Something broke", further => "details" );
144
145   ok( $future->is_ready, '$future->fail marks future ready' );
146
147   is( scalar $future->failure, "Something broke", '$future->failure yields exception' );
148   is_deeply( [ $future->failure ], [ "Something broke", "further", "details" ],
149         '$future->failure yields details in list context' );
150}
151
152# fail chaining
153{
154   my $future = Future->new;
155
156   my $f1 = Future->new;
157   my $f2 = Future->new;
158
159   $future->on_fail( $f1 );
160   $future->on_ready( $f2 );
161
162   my $failure_1;
163   $f1->on_fail( sub { ( $failure_1 ) = @_ } );
164   my $failure_2;
165   $f2->on_fail( sub { ( $failure_2 ) = @_ } );
166
167   $future->fail( "Chained failure" );
168
169   is( $failure_1, "Chained failure", 'Failure chained via ->on_fail( $f )' );
170   is( $failure_2, "Chained failure", 'Failure chained via ->on_ready( $f )' );
171}
172
173# immediately failed
174{
175   my $future = Future->fail( "Already broken" );
176
177   my $on_done;
178   identical( $future->on_done( sub { $on_done++; } ), $future, '->on_done returns future for immediate' );
179   my $failure;
180   identical( $future->on_fail( sub { ( $failure ) = @_; } ), $future, '->on_fail returns future for immediate' );
181
182   is( $failure, "Already broken", 'Exception passed to on_fail for already-failed future' );
183   ok( !$on_done, 'on_done not invoked for immediately-failed future' );
184
185   my $f1 = Future->new;
186   my $f2 = Future->new;
187
188   $future->on_fail( $f1 );
189   $future->on_ready( $f2 );
190
191   ok( $f1->is_ready, 'Chained ->on_done for immediate future' );
192   is_deeply( [ $f1->failure ], [ "Already broken" ], 'Results from chained via ->on_done for immediate future' );
193   ok( $f2->is_ready, 'Chained ->on_ready for immediate future' );
194   is_deeply( [ $f2->failure ], [ "Already broken" ], 'Results from chained via ->on_ready for immediate future' );
195}
196
197# die
198{
199   my $future = Future->new;
200
201   $future->on_done( sub { die "on_done called for failed future" } );
202   my $failure;
203   $future->on_fail( sub { ( $failure ) = @_; } );
204
205   my $file = __FILE__;
206   my $line = __LINE__+1;
207   identical( $future->die( "Something broke" ), $future, '->die returns $future' );
208
209   ok( $future->is_ready, '$future->die marks future ready' );
210
211   is( scalar $future->failure, "Something broke at $file line $line\n", '$future->failure yields exception' );
212   is( exception { $future->result }, "Something broke at $file line $line\n", '$future->result throws exception' );
213
214   is( $failure, "Something broke at $file line $line\n", 'Exception passed to on_fail' );
215}
216
217# call
218{
219   my $future;
220
221   $future = Future->call( sub { Future->done( @_ ) }, 1, 2, 3 );
222
223   ok( $future->is_ready, '$future->is_ready from immediate Future->call' );
224   is_deeply( [ $future->result ], [ 1, 2, 3 ], '$future->result from immediate Future->call' );
225
226   $future = Future->call( sub { die "argh!\n" } );
227
228   ok( $future->is_ready, '$future->is_ready from immediate exception of Future->call' );
229   is( $future->failure, "argh!\n", '$future->failure from immediate exception of Future->call' );
230
231   $future = Future->call( sub { "non-future" } );
232
233   ok( $future->is_ready, '$future->is_ready from non-future returning Future->call' );
234   like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/,
235      '$future->failure from non-future returning Future->call' );
236}
237
238# unwrap
239{
240   is_deeply( [ Future->unwrap( Future->done( 1, 2, 3 ) ) ],
241              [ 1, 2, 3 ],
242              'Future->unwrap Future in list context' );
243   is_deeply( [ Future->unwrap( 1, 2, 3 ) ],
244              [ 1, 2, 3 ],
245              'Future->unwrap plain list in list context' );
246
247   is( scalar Future->unwrap( Future->done( qw( a b c ) ) ),
248       "a",
249       'Future->unwrap Future in scalar context' );
250   is( scalar Future->unwrap( qw( a b c ) ),
251       "a",
252       'Future->unwrap plain list in scalar context' );
253}
254
255# label
256{
257   my $f = Future->new;
258
259   identical( $f->set_label( "the label" ), $f, '->set_label returns $f' );
260
261   is( $f->label, "the label", '->label returns the label' );
262
263   $f->cancel;
264}
265
266# retain
267{
268   my @args;
269   foreach my $method (qw( cancel done fail )) {
270      my $f = Future->new;
271      is_oneref( $f, 'start with refcount 1' );
272
273      is( $f->retain, $f, '->retain returns original Future' );
274
275      is_refcount( $f, 2, 'refcount is now increased' );
276
277      ok( $f->$method( @args ), "can call ->$method" );
278      is_oneref( $f, 'refcount drops when completed' );
279
280      push @args, 'x';
281   }
282}
283
284# await
285{
286   my $future = Future->done( "result" );
287   identical( $future->await, $future, '->await returns invocant' );
288}
289
290# ->result while pending
291{
292   like( exception { Future->new->result; },
293      qr/^Future=HASH\(0x[0-9a-f]+\) is not yet ready /,
294      '->result while pending raises exception' );
295}
296
297# resolve and reject aliases
298{
299   my $fdone = Future->resolve( "abc" );
300   ok( $fdone->is_done, 'Future->resolve' );
301
302   my $ffail = Future->reject( "def\n" );
303   ok( $ffail->is_failed, 'Future->reject' );
304}
305
306done_testing;
307