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