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