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{ 15 my $f1 = Future->new; 16 17 my $called = 0; 18 my $fseq = $f1->followed_by( sub { 19 $called++; 20 identical( $_[0], $f1, 'followed_by block passed $f1' ); 21 return $_[0]; 22 } ); 23 24 ok( defined $fseq, '$fseq defined' ); 25 isa_ok( $fseq, "Future", '$fseq' ); 26 27 is_oneref( $fseq, '$fseq has refcount 1 initially' ); 28 # Two refs; one in lexical $f1, one in $fseq's cancellation closure 29 is_refcount( $f1, 2, '$f1 has refcount 2 initially' ); 30 31 is( $called, 0, '$called before $f1 done' ); 32 33 $f1->done( results => "here" ); 34 35 is( $called, 1, '$called after $f1 done' ); 36 37 ok( $fseq->is_ready, '$fseq is done after $f1 done' ); 38 is_deeply( [ $fseq->result ], [ results => "here" ], '$fseq->result returns results' ); 39 40 is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); 41 is_oneref( $f1, '$f1 has refcount 1 before EOF' ); 42} 43 44{ 45 my $f1 = Future->new; 46 47 my $called = 0; 48 my $fseq = $f1->followed_by( sub { 49 $called++; 50 identical( $_[0], $f1, 'followed_by block passed $f1' ); 51 return $_[0]; 52 } ); 53 54 ok( defined $fseq, '$fseq defined' ); 55 isa_ok( $fseq, "Future", '$fseq' ); 56 57 is_oneref( $fseq, '$fseq has refcount 1 initially' ); 58 59 is( $called, 0, '$called before $f1 done' ); 60 61 $f1->fail( "failure\n" ); 62 63 is( $called, 1, '$called after $f1 failed' ); 64 65 ok( $fseq->is_ready, '$fseq is ready after $f1 failed' ); 66 is_deeply( [ $fseq->failure ], [ "failure\n" ], '$fseq->failure returns failure' ); 67 68 is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); 69} 70 71# code dies 72{ 73 my $f1 = Future->new; 74 75 my $fseq = $f1->followed_by( sub { 76 die "It fails\n"; 77 } ); 78 79 ok( !defined exception { $f1->done }, 'exception not propagated from code call' ); 80 81 ok( $fseq->is_ready, '$fseq is ready after code exception' ); 82 is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); 83} 84 85# Cancellation 86{ 87 my $f1 = Future->new; 88 89 my $fseq = $f1->followed_by( 90 sub { die "followed_by of cancelled Future should not be invoked" } 91 ); 92 93 $fseq->cancel; 94 95 ok( $f1->is_cancelled, '$f1 cancelled by $fseq->cancel' ); 96 97 $f1 = Future->new; 98 my $f2 = Future->new; 99 100 $fseq = $f1->followed_by( sub { $f2 } ); 101 102 $f1->done; 103 $fseq->cancel; 104 105 ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel' ); 106 107 $f1 = Future->done; 108 $f2 = Future->new; 109 110 $fseq = $f1->followed_by( sub { $f2 } ); 111 112 $fseq->cancel; 113 114 ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel on $f1 immediate' ); 115} 116 117# immediately done 118{ 119 my $f1 = Future->done; 120 121 my $called = 0; 122 my $fseq = $f1->followed_by( 123 sub { $called++; return $_[0] } 124 ); 125 126 is( $called, 1, 'followed_by block invoked immediately for already-done' ); 127} 128 129# immediately done 130{ 131 my $f1 = Future->fail("Failure\n"); 132 133 my $called = 0; 134 my $fseq = $f1->followed_by( 135 sub { $called++; return $_[0] } 136 ); 137 138 is( $called, 1, 'followed_by block invoked immediately for already-failed' ); 139} 140 141# immediately code dies 142{ 143 my $f1 = Future->done; 144 145 my $fseq; 146 147 ok( !defined exception { 148 $fseq = $f1->followed_by( sub { 149 die "It fails\n"; 150 } ); 151 }, 'exception not propagated from ->followed_by on immediate' ); 152 153 ok( $fseq->is_ready, '$fseq is ready after code exception on immediate' ); 154 is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception on immediate' ); 155} 156 157# Void context raises a warning 158{ 159 my $warnings; 160 local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; 161 162 Future->done->followed_by( 163 sub { Future->new } 164 ); 165 166 like( $warnings, 167 qr/^Calling ->followed_by in void context at /, 168 'Warning in void context' ); 169} 170 171# Non-Future return is upgraded 172{ 173 my $f1 = Future->new; 174 175 my $fseq = $f1->followed_by( sub { "result" } ); 176 my $fseq2 = $f1->followed_by( sub { Future->done } ); 177 178 is( exception { $f1->done }, undef, 179 '->done with non-Future return from ->followed_by does not die' ); 180 181 is( scalar $fseq->result, "result", 182 'non-Future return from ->followed_by is upgraded' ); 183 184 ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); 185 186 my $fseq3; 187 is( exception { $fseq3 = $f1->followed_by( sub { "result" } ) }, undef, 188 'non-Future return from ->followed_by on immediate does not die' ); 189 190 is( scalar $fseq3->result, "result", 191 'non-Future return from ->followed_by on immediate is upgraded' ); 192} 193 194done_testing; 195