File Coverage

blib/lib/Test/Future/AsyncAwait/Awaitable.pm
Criterion Covered Total %
statement 78 93 83.8
branch 8 18 44.4
condition 1 8 12.5
subroutine 14 15 93.3
pod 1 1 100.0
total 102 135 75.5


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2020-2023 -- leonerd@leonerd.org.uk
5              
6             package Test::Future::AsyncAwait::Awaitable 0.66;
7              
8 1     1   236614 use v5.14;
  1         12  
9 1     1   7 use warnings;
  1         3  
  1         25  
10              
11 1     1   5 use Test2::V0;
  1         2  
  1         6  
12              
13 1     1   1241 use Exporter 'import';
  1         2  
  1         99  
14             our @EXPORT_OK = qw(
15             test_awaitable
16             );
17              
18             =head1 NAME
19              
20             C - conformance tests for awaitable role API
21              
22             =head1 SYNOPSIS
23              
24             use Test::More;
25             use Test::Future::AsyncAwait::Awaitable;
26              
27             use My::Future::Subclass;
28              
29             test_awaitable "My subclass of Future",
30             class => "My::Future::Subclass";
31              
32             done_testing;
33              
34             =head1 DESCRIPTION
35              
36             This module provides a single test function, which runs a suite of subtests to
37             check that a given class provides a useable implementation of the
38             L role. It runs tests that simulate various
39             ways in which L will try to use an instance of this class,
40             to check that the implementation is valid.
41              
42             =cut
43              
44             =head1 FUNCTIONS
45              
46             =cut
47              
48             =head2 test_awaitable
49              
50             test_awaitable( $title, %args )
51              
52             Runs the API conformance tests. C<$title> is printed in the test description
53             output so should be some human-friendly string.
54              
55             Takes the following named arguments:
56              
57             =over 4
58              
59             =item class => STRING
60              
61             Gives the name of the class. This is the class on which the C
62             and C methods will be invoked.
63              
64             =item new => CODE
65              
66             Optional. Gives a callback function to invoke to construct a new pending
67             instance; used by the tests to create pending instances that would be passed
68             into the C keyword. As this is not part of the API as such, the test
69             code does not rely on being able to directly perform it via the API.
70              
71             This argument is optional; if not provided the tests will simply try to invoke
72             the regular C constructor on the given class name. For most
73             implementations this should be sufficient.
74              
75             $f = $new->()
76              
77             =item cancel => CODE
78              
79             Optional. Gives a callback function to invoke to cancel a pending instance, if
80             the implementation provides cancellation semantics. If this callback is
81             provided then an extra subtest suite is run to check the API around
82             cancellation.
83              
84             $cancel->( $f )
85              
86             =item force => CODE
87              
88             Optional. Gives a callback function to invoke to wait for a promise to invoke
89             its on-ready callbacks. Some future-like implementations will run these
90             immediately when the future is marked as done or failed, and so this callback
91             will not be required. Other implementations will defer these invocations,
92             perhaps until the next tick of an event loop or similar. In the latter case,
93             these implementations should provide a way for the test to wait for this to
94             happen.
95              
96             $force->( $f )
97              
98             =back
99              
100             =cut
101              
102             my $FILE = __FILE__;
103              
104             my %FIXED_MODULE_VERSIONS = (
105             'Future::PP' => '0.50',
106             'Future::XS' => '0.09',
107             );
108              
109             sub _complain_package_version
110             {
111 0     0   0 my ( $pkg ) = @_;
112              
113             # Drill down to the most base class that isn't Future::_base
114             {
115 1     1   7 no strict 'refs';
  1         2  
  1         119  
  0         0  
116 0   0     0 $pkg = ${"${pkg}::ISA"}[0] while @{"${pkg}::ISA"} and ${"${pkg}::ISA"}[0] ne "Future::_base";
  0         0  
  0         0  
  0         0  
117             }
118              
119 1     1   8 my $pkgver = do { no strict 'refs'; ${"${pkg}::VERSION"} };
  1         2  
  1         1045  
  0         0  
  0         0  
  0         0  
120 0         0 my $wantver = $FIXED_MODULE_VERSIONS{$pkg};
121              
122 0 0 0     0 if( defined $wantver && $pkgver < $wantver ) {
123 0         0 diag( "$pkg VERSION is only $pkgver; this might be fixed by updating to version $wantver" );
124             }
125             else {
126 0         0 diag( "$pkg VERSION is $pkgver; maybe a later version fixes it?" );
127             }
128             }
129              
130             sub test_awaitable
131             {
132 1     1 1 105 my ( $title, %args ) = @_;
133              
134 1         4 my $class = $args{class};
135 1   50 4   13 my $new = $args{new} || sub { return $class->new() };
  4         16  
136 1         3 my $cancel = $args{cancel};
137 1         3 my $force = $args{force};
138              
139             subtest "$title immediate done" => sub {
140 1     1   6251 ok( my $f = $class->AWAIT_NEW_DONE( "result" ), "AWAIT_NEW_DONE yields object" );
141              
142 1         431 ok( $f->AWAIT_IS_READY, 'AWAIT_IS_READY true' );
143 1         327 ok( !$f->AWAIT_IS_CANCELLED, 'AWAIT_IS_CANCELLED false' );
144              
145 1         289 is( [ $f->AWAIT_GET ], [ "result" ], 'AWAIT_GET in list context' );
146 1         870 is( scalar $f->AWAIT_GET, "result", 'AWAIT_GET in scalar context' );
147 1         411 ok( defined eval { $f->AWAIT_GET; 1 }, 'AWAIT_GET in void context' );
  1         9  
  1         15  
148 1         13 };
149              
150             subtest "$title immediate fail" => sub {
151 1     1   310 ok( my $f = $class->AWAIT_NEW_FAIL( "Oopsie" ), "AWAIT_NEW_FAIL yields object" );
152              
153 1         277 ok( $f->AWAIT_IS_READY, 'AWAIT_IS_READY true' );
154 1         238 ok( !$f->AWAIT_IS_CANCELLED, 'AWAIT_IS_CANCELLED false' );
155              
156 1         232 my $LINE = __LINE__+1;
157 1         2 ok( !defined eval { $f->AWAIT_GET; 1 }, 'AWAIT_GET in void context' );
  1         5  
  0         0  
158 1 50       534 is( $@, "Oopsie at $FILE line $LINE.\n", 'AWAIT_GET throws exception' ) or
159             _complain_package_version( ref $f );
160 1         2357 };
161              
162 1 50       1841 my $fproto = $new->() or BAIL_OUT( "new did not yield an instance" );
163              
164             subtest "$title deferred done" => sub {
165 1     1   296 ok( my $f = $fproto->AWAIT_CLONE, 'AWAIT_CLONE yields object' );
166              
167 1         312 ok( !$f->AWAIT_IS_READY, 'AWAIT_IS_READY false' );
168              
169 1         252 $f->AWAIT_DONE( "Late result" );
170              
171 1         59 ok( $f->AWAIT_IS_READY, 'AWAIT_IS_READY true' );
172              
173 1         247 is( scalar $f->AWAIT_GET, "Late result", 'AWAIT_GET in scalar context' );
174 1         18 };
175              
176             subtest "$title deferred fail" => sub {
177 1     1   286 ok( my $f = $fproto->AWAIT_CLONE, 'AWAIT_CLONE yields object' );
178              
179 1         250 ok( !$f->AWAIT_IS_READY, 'AWAIT_IS_READY false' );
180              
181 1         249 $f->AWAIT_FAIL( "Late oopsie" );
182              
183 1         46 ok( $f->AWAIT_IS_READY, 'AWAIT_IS_READY true' );
184              
185 1         242 my $LINE = __LINE__+1;
186 1         3 ok( !defined eval { $f->AWAIT_GET; 1 }, 'AWAIT_GET in void context' );
  1         5  
  0         0  
187 1 50       380 is( $@, "Late oopsie at $FILE line $LINE.\n", 'AWAIT_GET throws exception' ) or
188             _complain_package_version( ref $f );
189 1         1701 };
190              
191             subtest "$title on-ready" => sub {
192 1 50   1   285 my $f = $new->() or BAIL_OUT( "new did not yield an instance" );
193              
194 1         14 my $called;
195 1         12 $f->AWAIT_ON_READY( sub { $called++ } );
  1         53  
196 1         21 ok( !$called, 'AWAIT_ON_READY CB not yet invoked' );
197              
198 1         241 $f->AWAIT_DONE( "ping" );
199 1 50       9 $force->( $f ) if $force;
200 1         5 ok( $called, 'AWAIT_ON_READY CB now invoked' );
201 1         1908 };
202              
203             $cancel and subtest "$title cancellation" => sub {
204 1 50   1   342 my $f1 = $new->() or BAIL_OUT( "new did not yield an instance" );
205              
206 1         14 my $f2 = $f1->AWAIT_CLONE;
207              
208 1         15 $f1->AWAIT_CHAIN_CANCEL( $f2 );
209              
210 1         29 ok( !$f2->AWAIT_IS_CANCELLED, 'AWAIT_IS_CANCELLED false before cancellation' );
211              
212 1         271 $cancel->( $f1 );
213              
214 1         112 ok( $f2->AWAIT_IS_CANCELLED, 'AWAIT_IS_CANCELLED true after AWAIT_ON_CANCEL propagation' );
215              
216 1 50       247 my $f3 = $new->() or BAIL_OUT( "new did not yield an instance" );
217              
218 1         14 my $cancelled;
219 1         16 $f3->AWAIT_ON_CANCEL( sub { $cancelled++ } );
  1         16  
220              
221 1         13 $cancel->( $f3 );
222              
223 1         26 ok( $cancelled, 'AWAIT_ON_CANCEL invoked callback' );
224 1 50       1339 };
225             }
226              
227             =head1 AUTHOR
228              
229             Paul Evans
230              
231             =cut
232              
233             0x55AA;