diff options
| author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-03-10 19:55:44 +0000 |
|---|---|---|
| committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-03-10 19:55:44 +0000 |
| commit | 8cc5160aefb2ba3611d1d5d6b12b996227f9da72 (patch) | |
| tree | 256923c9d568f659ca72d254993e6a40c439a7b5 | |
| download | Future-tarball-master.tar.gz | |
Future-0.32HEADFuture-0.32master
37 files changed, 8571 insertions, 0 deletions
diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..d3b1d2f --- /dev/null +++ b/Build.PL @@ -0,0 +1,87 @@ +use strict; +use warnings; + +use Module::Build; + +# This version of Future contains an important bugfix around weak references +# in sequence Futures. Unfortunately, a lot of existing CPAN code is known to +# rely on this behaviour, and will break if this module is upgraded. +# +# Abort if any of the following modules are installed at versions less than +# the first known-working version. They must be updated before Future can be +# installed. +my %FIXED = ( + 'IO::Async' => '0.62', + 'IO::Async::SSL' => '0.14', + 'Net::Async::CassandraCQL' => '0.11', + 'Net::Async::FTP' => '0.08', + 'Net::Async::HTTP' => '0.34', + 'Net::Async::WebSocket' => '0.08', +); + +my $printed; +foreach my $module ( sort keys %FIXED ) { + my $needsver = $FIXED{$module}; + ( my $modfile = "$module.pm" ) =~ s{::}{/}g; + + next unless eval { require $modfile }; + next if ( my $instver = $module->VERSION ) >= $needsver; + + print STDERR "Installing this version of Future will fix a bug that the following installed\n". + "modules rely on. You must upgrade these modules to a later version after\n". + "Future is installed, or they will not work correctly.\n\n" unless $printed; + + print STDERR " * $module (installed $instver; need at least $needsver)\n"; + $printed++; +} +print STDERR "\n" if $printed; + +if( $printed and -t STDIN ) { + # Attended update; might as well ask the user to confirm and exit if not + my $reply = Module::Build->prompt( + "Are you still sure you wish to go ahead with this upgrade?\n" . + "[enter 'yes' to continue]: ", + "no" + ); + + die "Aborting install due to broken dependent modules\n" unless $reply =~ m/^y/i; +} + +my $build = Module::Build->new( + module_name => 'Future', + test_requires => { + 'Test::Identity' => 0, + 'Test::Fatal' => 0, + 'Test::More' => '0.88', # done_testing + 'Test::Refcount' => 0, + }, + requires => { + 'perl' => '5.008', # fails on 5.6 smokers; no idea why + 'Carp' => '1.25', # new message format with trailing period + 'Test::Builder::Module' => 0, + 'Time::HiRes' => 0, + }, + meta_merge => { + # It's unlikely at the time of writing that any CPAN client actually + # pays attention to this field, but it's nice to declare it on CPAN + # anyway so people will know I want to use it; maybe one day clients + # will follow it... + x_breaks => { do { + map { $_ => "< $FIXED{$_}" } keys %FIXED + }}, + }, + configure_requires => { + 'Module::Build' => '0.4004', # test_requires + }, + license => 'perl', + create_makefile_pl => 'traditional', + create_license => 1, + create_readme => 1, + meta_merge => { + resources => { + x_IRC => "irc://irc.perl.org/#io-async", + }, + }, +); + +$build->create_build_script; @@ -0,0 +1,273 @@ +Revision history for Future + +0.32 2015/03/10 19:54:22 + [CHANGES] + * Documentation updates for new ->wrap_cb method + + [BUGFIXES] + * Empty convergents should respect subclassing (RT97537) + * Adjust loss-report regexp for bleadperl (RT99002 again) + * Make trailing periods in warning tests optional, to account for + Carp version changes (RT100685) + +0.31 2015/03/08 17:50:06 + [CHANGES] + * Added debugging warning when destroying a failed Future that has + not reported its failure (RT102198) + * Have ->and_then / ->or_else die immediately to further their + deprecation + * Announce done_cb/fail_cb/cancel_cb as deprecated in favour of curry + * Provide ->wrap_cb method (experimental) + + [BUGFIXES] + * Ensure that Test::Future does not retain Futures once they are + complete (RT101128) + * 'use Future' in Future::Utils (RT102167) + +0.30 2014/11/26 14:29:28 + [CHANGES] + * Rename 'dependent' futures to 'convergent' + * Removed examples/ scripts that now exist as independent modules + * Added ->without_cancel + * Sanity-check the $code argument to ->on_{ready,done,fail,cancel} to + ensure it is callable or a Future + + [BUGFIXES] + * Ensure that 'ready_at' is always set in DEBUG mode + * Fix DEBUG 'lost_at' line number reporting tests for latest + bleadperl (RT99002) + * Ensure that if Future::Utils::repeat condition code dies, that is + passed to the result Future and not propagated to the caller + (RT100067) + * Failure by returning a non-Future from a sequencing code block + should report as a failed Future, not throw exception to caller + +0.29 2014/07/17 12:18:12 + [CHANGES] + * Added Test::Future + * Stronger deprecations - repeat {} on failures warns every time, + ->and_then / ->or_else warn once + + [BUGFIXES] + * Define the behaviour of dependent futures when components are + cancelled. (Partially fixes RT96685) + * Use Module::Build->prompt (RT96409) + * Ensure that repeat on an empty foreach list or empty generator + without 'otherwise' behaves correctly, just yield an immediate + +0.28 2014/06/08 22:43:40 + [CHANGES] + * Added ->label + * Added ->btime, rtime, elapsed tracing timers + * Better handling of 'breaks' version detection + +0.27 2014/06/06 17:42:27 + [BUGFIXES] + * Depend on Carp 1.25 for the new message format with trailing + period, so tests work + +0.26 2014/06/01 12:52:53 + [CHANGES] + * Added ->is_failed accessor + * Implement ->export_to_level in Future::Utils + * Print a warning about lost sequence Futures + * Allow Future->done and Future->fail as simple class constructors + to return immediates + * Added Future->unwrap + + [BUGFIXES] + * Ensure that sequence futures are weaken()ed in the forward + direction. + **NOTE** This will potentially break existing code that depended on + strong references. This old code was, however, broken. + +0.25 2014/02/22 03:47:08 + [BUGFIXES] + * Fix warning-matching test in unit test for both older and newer + versions of Carp + +0.24 2014/02/21 17:57:49 + [CHANGES] + * Have repeat print a warning if it is asked to retry over a failure + * Change documentation to suggest try_repeat instead of repeat for + retries over failure + * Check at call time that sequencing callbacks really are callable, + leading to neater error messages (RT93164) + +0.23 2014/01/19 15:26:55 + [CHANGES] + * Link to Futures advent calendar 2013 + * Fixes/additions to Phrasebook documentation, including section + about tree recursion + + [BUGFIXES] + * Ensure that late addition of additional items to a fmap foreach + array works correctly even with concurrency + +0.22 2014/01/12 03:12:18 + [CHANGES] + * Ignore ->done or ->fail on cancelled Futures + * Added ->then_done, ->then_fail, ->else_done, ->else_fail + * Neaten up naming of fmap* family - provide both long and short + names for each function + * Added Future::Utils::call and call_with_escape + * Ensure that dependent futures on subclasses tries to use derived + futures as prototype if possible + +0.21 2013/12/29 18:14:41 + [CHANGES] + * Major performance improvement by folding out some layers of sub {} + wrapping in sequencing operations + * Added ->then_with_f and ->else_with_f + + [BUGFIXES] + * Don't start another trial after cancelling a repeat() (RT91147) + +0.20 2013/11/18 19:14:27 + [CHANGES] + * Include an indication of done/failed/cancelled status of a Future + when ->done or ->failing an already-ready one + + [BUGFIXES] + * Declare requires perl 5.8 because it fails on 5.6 smokers - no idea + why + * Fix a couple of typoes in docs (RT89185) + +0.19 2013/09/27 13:31:16 + [BUGFIXES] + * Guard against odd things happening during ->cancel at global + destruction (RT88967) + +0.18 2013/09/20 19:09:57 + [CHANGES] + * Added 'try_repeat' and 'try_repeat_until_success' aliases + * @CARP_NOT trust between Future and Future::Utils + + [BUGFIXES] + * Fix to concurrent non-immediate + immediate fmap* return values + +0.17 2013/09/07 16:53:47 + [CHANGES] + * Performance improvement by using direct member access instead of + accessor methods + * Documentation updates; suggestion of documentation style for + Future-returning code + + [BUGFIXES] + * Respect subclassing of immediate->followed_by and dependent futures + with mixed subclass or immediate components + +0.16 CHANGES: + * Proper behaviour of ->wait_all and ->needs_all on an empty list - + just return empty immediate done + * Proper behaviour of ->wait_any and ->needs_any on an empty list - + return an immediate failure + * Performance improvement to ->done for immediate Future->new->done + * Keep a count of pending child futures to avoid quadratic behaviour + due to linear scan of children every time one completes + * Improve efficiency of Future::Utils::repeat and fmap* when trials + return immediates + * Make repeat and fmap* 'return' argument optional by cloning the + first non-immediate trial + * Rework unit tests to avoid dependency on Test::Warn + +0.15 CHANGES: + * Added Future->call constructor + * Fixed reference-retaining bug in Future's on_cancel callback list + * Ensure that ->cancel returns $self even on immediates + * Documentation updates to mention ->wrap and ->call, and the fmap + family + +0.14 CHANGES: + * Added Future->wrap constructor + * Added Future::Utils::fmap* family of functions + + BUGFIXES: + * Fixed a precedence bug in 'and' vs && + +0.13 CHANGES: + * Added ->then and ->else methods; like ->and_then but code is passed + result directly instead of invocant future + * Added repeat { ... } foreach, otherwise argument to set final + result and also handle empty lists + * Added repeat { ... } generate + * Turn repeat { ... } code block exceptions into failed futures + * Ensure that ->on_cancel returns $self (RT85134) + * Documentation / Phrasebook updates to demonstrate newly added + features + +0.12 CHANGES: + * Take a 'return' argument to Future::Utils::repeat; deprecate the + trial-cloning feature for subclasses + * Have ->followed_by/etc... print a warning in void context + * Throw an exception when ->followed_by/etc.. code does not yield a + Future (RT84188) + * Ensure that ->needs_all/->needs_any work correctly on a mix of + immediate and pending Futures (RT84187) + * Ensure that ->on_done/->on_fail always return invocant (RT84313) + * Ensure that ->on_ready($f) works on cancelled Futures (RT84312) + +0.11 CHANGES: + * Added Future::Phrasebook documentation file + * Ensure that exceptions thrown from ->followed_by code block are + caught and turned into failed Futures + * Fix filename regexp matches for unit-tests so they work on Windows + +0.10 BUGFIXES: + * Account for newer Carp version in unit tests, which appends + trailing period to messages + +0.09 CHANGES: + * Split ->fail method into new ->die call, only append caller + file/line to the exception in the latter + * Various documentation and example improvements + +0.08 CHANGES: + * Ignore attempts to cancel already-complete or already-cancelled + futures, or to attach ->on_cancel callbacks to them + * $future->get should return the first result in scalar context + * Added Future::Utils with repeat { ...} and + repeat_until_success { ... } looping constructs + + * Link to LPW2012 talk slides + +0.07 CHANGES: + * Leak debugging + +0.06 CHANGES: + * Remembered to actually include the example scripts. No other actual + code changes. + +0.05 CHANGES: + * Respect subclassing by allowing ->new on instances + * Allow subclasses to provide an ->await method which will be used + by ->get and ->failure + * Added some example scripts to demonstrate how to use Futures with + various event systems + +0.04 CHANGES: + * Fix implementation of sequenced futures to work properly on + immediates + * Ensure that future->future chaining via callbacks works correctly + on immediates + * Link to "curry" in the docs about CODE-returning convenience + accessors ->done_cb, ->fail_cb and ->cancel_cb + +0.03 INCOMPATIBLE CHANGES: + * Future->needs_all and Future->needs_any now return dependents' + results + + CHANGES: + * Removed $future->( ... ) callable override + * Pass $f1 to ->or_else code block by symmetry with ->and_then + * Added $f->followed_by + * Added Future->wait_any dependent future constructor + * Rearranged documentation and added more examples + +0.02 CHANGES: + * Rearranged non-leaf future logic + * Added {pending,ready,done,failed,cancelled}_futures accessors + * Added Future->needs_any constructor + +0.01 First version, released on an unsuspecting world. + @@ -0,0 +1,379 @@ +This software is copyright (c) 2015 by Paul Evans <leonerd@leonerd.org.uk>. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +Terms of the Perl programming language system itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--- The GNU General Public License, Version 1, February 1989 --- + +This software is Copyright (c) 2015 by Paul Evans <leonerd@leonerd.org.uk>. + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 2015 by Paul Evans <leonerd@leonerd.org.uk>. + +This is free software, licensed under: + + The Artistic License 1.0 + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of +the package the right to use and distribute the Package in a more-or-less +customary fashion, plus the right to make reasonable modifications. + +Definitions: + + - "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through + textual modification. + - "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. + - "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. + - "You" is you, if you're thinking about copying or distributing this Package. + - "Reasonable copying fee" is whatever you can justify on the basis of media + cost, duplication charges, time of people involved, and so on. (You will + not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) + - "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived +from the Public Domain or from the Copyright Holder. A Package modified in such +a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided that +you insert a prominent notice in each changed file stating how and when you +changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or an + equivalent medium, or placing the modifications on a major archive site + such as ftp.uu.net, or by allowing the Copyright Holder to include your + modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict with + standard executables, which must also be provided, and provide a separate + manual page for each non-standard executable that clearly documents how it + differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where to + get the Standard Version. + + b) accompany the distribution with the machine-readable source of the Package + with your modifications. + + c) accompany any non-standard executables with their corresponding Standard + Version executables, giving the non-standard executables non-standard + names, and clearly documenting the differences in manual pages (or + equivalent), together with instructions on where to get the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this Package. You +may not charge a fee for this Package itself. However, you may distribute this +Package in aggregate with other (possibly commercial) programs as part of a +larger (possibly commercial) software distribution provided that you do not +advertise this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output +from the programs of this Package do not automatically fall under the copyright +of this Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED +WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..d44f938 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,37 @@ +Build.PL +Changes +examples/io-async.pl +lib/Future.pm +lib/Future/Phrasebook.pod +lib/Future/Utils.pm +lib/Test/Future.pm +LICENSE +Makefile.PL +MANIFEST This list of files +META.json +META.yml +README +t/00use.t +t/01future.t +t/02cancel.t +t/03then.t +t/04else.t +t/05then-else.t +t/06followed_by.t +t/09transform.t +t/10wait_all.t +t/11wait_any.t +t/12needs_all.t +t/13needs_any.t +t/20subclass.t +t/21debug.t +t/22wrap_cb.t +t/30utils-call.t +t/31utils-call-with-escape.t +t/32utils-repeat.t +t/33utils-repeat-generate.t +t/34utils-repeat-foreach.t +t/35utils-map-void.t +t/36utils-map.t +t/50test-future.t +t/99pod.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..d6429b8 --- /dev/null +++ b/META.json @@ -0,0 +1,61 @@ +{ + "abstract" : "represent an operation awaiting completion", + "author" : [ + "Paul Evans <leonerd@leonerd.org.uk>" + ], + "dynamic_config" : 1, + "generated_by" : "Module::Build version 0.421", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Future", + "prereqs" : { + "configure" : { + "requires" : { + "Module::Build" : "0.4004" + } + }, + "runtime" : { + "requires" : { + "Carp" : "1.25", + "Test::Builder::Module" : "0", + "Time::HiRes" : "0", + "perl" : "5.008" + } + }, + "test" : { + "requires" : { + "Test::Fatal" : "0", + "Test::Identity" : "0", + "Test::More" : "0.88", + "Test::Refcount" : "0" + } + } + }, + "provides" : { + "Future" : { + "file" : "lib/Future.pm", + "version" : "0.32" + }, + "Future::Utils" : { + "file" : "lib/Future/Utils.pm", + "version" : "0.32" + }, + "Test::Future" : { + "file" : "lib/Test/Future.pm", + "version" : "0.32" + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/" + ], + "x_IRC" : "irc://irc.perl.org/#io-async" + }, + "version" : "0.32" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..cb38c9a --- /dev/null +++ b/META.yml @@ -0,0 +1,37 @@ +--- +abstract: 'represent an operation awaiting completion' +author: + - 'Paul Evans <leonerd@leonerd.org.uk>' +build_requires: + Test::Fatal: '0' + Test::Identity: '0' + Test::More: '0.88' + Test::Refcount: '0' +configure_requires: + Module::Build: '0.4004' +dynamic_config: 1 +generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.142690' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Future +provides: + Future: + file: lib/Future.pm + version: '0.32' + Future::Utils: + file: lib/Future/Utils.pm + version: '0.32' + Test::Future: + file: lib/Test/Future.pm + version: '0.32' +requires: + Carp: '1.25' + Test::Builder::Module: '0' + Time::HiRes: '0' + perl: '5.008' +resources: + IRC: irc://irc.perl.org/#io-async + license: http://dev.perl.org/licenses/ +version: '0.32' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..153cfbb --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,17 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.4210 +require 5.008; +use ExtUtils::MakeMaker; +WriteMakefile +( + 'NAME' => 'Future', + 'VERSION_FROM' => 'lib/Future.pm', + 'PREREQ_PM' => { + 'Carp' => '1.25', + 'Test::Builder::Module' => 0, + 'Time::HiRes' => 0 + }, + 'INSTALLDIRS' => 'site', + 'EXE_FILES' => [], + 'PL_FILES' => {} +) +; @@ -0,0 +1,945 @@ +NAME + `Future' - represent an operation awaiting completion + +SYNOPSIS + my $future = Future->new; + + perform_some_operation( + on_complete => sub { + $future->done( @_ ); + } + ); + + $future->on_ready( sub { + say "The operation is complete"; + } ); + +DESCRIPTION + A `Future' object represents an operation that is currently in progress, + or has recently completed. It can be used in a variety of ways to manage + the flow of control, and data, through an asynchronous program. + + Some futures represent a single operation and are explicitly marked as + ready by calling the `done' or `fail' methods. These are called "leaf" + futures here, and are returned by the `new' constructor. + + Other futures represent a collection of sub-tasks, and are implicitly + marked as ready depending on the readiness of their component futures as + required. These are called "convergent" futures here as they converge + control and data-flow back into one place. These are the ones returned + by the various `wait_*' and `need_*' constructors. + + It is intended that library functions that perform asynchronous + operations would use future objects to represent outstanding operations, + and allow their calling programs to control or wait for these operations + to complete. The implementation and the user of such an interface would + typically make use of different methods on the class. The methods below + are documented in two sections; those of interest to each side of the + interface. + + It should be noted however, that this module does not in any way provide + an actual mechanism for performing this asynchronous activity; it merely + provides a way to create objects that can be used for control and data + flow around those operations. It allows such code to be written in a + neater, forward-reading manner, and simplifies many common patterns that + are often involved in such situations. + + See also Future::Utils which contains useful loop-constructing + functions, to run a future-returning function repeatedly in a loop. + + SUBCLASSING + This class easily supports being subclassed to provide extra behavior, + such as giving the `get' method the ability to block and wait for + completion. This may be useful to provide `Future' subclasses with event + systems, or similar. + + Each method that returns a new future object will use the invocant to + construct its return value. If the constructor needs to perform + per-instance setup it can override the `new' method, and take context + from the given instance. + + sub new + { + my $proto = shift; + my $self = $proto->SUPER::new; + + if( ref $proto ) { + # Prototype was an instance + } + else { + # Prototype was a class + } + + return $self; + } + + If an instance provides a method called `await', this will be called by + the `get' and `failure' methods if the instance is pending. + + $f->await + + In most cases this should allow future-returning modules to be used as + if they were blocking call/return-style modules, by simply appending a + `get' call to the function or method calls. + + my ( $results, $here ) = future_returning_function( @args )->get; + + The examples directory in the distribution contains some examples of how + futures might be integrated with various event systems. + + MODULE DOCUMENTATION + Modules that provide future-returning functions or methods may wish to + adopt the following styles in some way, to document the eventual return + values from these futures. + + func( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + OBJ->method( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + Code returning a future that yields no values on success can use empty + parentheses. + + func( ... ) ==> () + + DEBUGGING + By the time a `Future' object is destroyed, it ought to have been + completed or cancelled. By enabling debug tracing of objects, this fact + can be checked. If a future object is destroyed without having been + completed or cancelled, a warning message is printed. + + $ PERL_FUTURE_DEBUG=1 perl -MFuture -E 'my $f = Future->new' + Future=HASH(0xaa61f8) was constructed at -e line 1 and was lost near -e line 0 before it was ready. + + Note that due to a limitation of perl's `caller' function within a + `DESTROY' destructor method, the exact location of the leak cannot be + accurately determined. Often the leak will occur due to falling out of + scope by returning from a function; in this case the leak location may + be reported as being the line following the line calling that function. + + $ PERL_FUTURE_DEBUG=1 perl -MFuture + sub foo { + my $f = Future->new; + } + + foo(); + print "Finished\n"; + + Future=HASH(0x14a2220) was constructed at - line 2 and was lost near - line 6 before it was ready. + Finished + + A warning is also printed in debug mode if a `Future' object is + destroyed that completed with a failure, but the object believes that + failure has not been reported anywhere. + + $ PERL_FUTURE_DEBUG=1 perl -Mblib -MFuture -E 'my $f = Future->fail("Oops")' + Future=HASH(0xac98f8) was constructed at -e line 1 and was lost near -e line 0 with an unreported failure of: Oops + + Such a failure is considered reported if the `get' or `failure' methods + are called on it, or it had at least one `on_ready' or `on_fail' + callback, or its failure is propagated to another `Future' instance (by + a sequencing or converging method). + +CONSTRUCTORS + $future = Future->new + $future = $orig->new + Returns a new `Future' instance to represent a leaf future. It will be + marked as ready by any of the `done', `fail', or `cancel' methods. It + can be called either as a class method, or as an instance method. Called + on an instance it will construct another in the same class, and is + useful for subclassing. + + This constructor would primarily be used by implementations of + asynchronous interfaces. + + $future = Future->done( @values ) + $future = Future->fail( $exception, @details ) + Shortcut wrappers around creating a new `Future' then immediately + marking it as done or failed. + + $future = Future->wrap( @values ) + If given a single argument which is already a `Future' reference, this + will be returned unmodified. Otherwise, returns a new `Future' instance + that is already complete, and will yield the given values. + + This will ensure that an incoming argument is definitely a `Future', and + may be useful in such cases as adapting synchronous code to fit + asynchronous libraries driven by `Future'. + + $future = Future->call( \&code, @args ) + A convenient wrapper for calling a `CODE' reference that is expected to + return a future. In normal circumstances is equivalent to + + $future = $code->( @args ) + + except that if the code throws an exception, it is wrapped in a new + immediate fail future. If the return value from the code is not a + blessed `Future' reference, an immediate fail future is returned instead + to complain about this fact. + +IMPLEMENTATION METHODS + These methods would primarily be used by implementations of asynchronous + interfaces. + + $future->done( @result ) + Marks that the leaf future is now ready, and provides a list of values + as a result. (The empty list is allowed, and still indicates the future + as ready). Cannot be called on a convergent future. + + If the future is already cancelled, this request is ignored. If the + future is already complete with a result or a failure, an exception is + thrown. + + Future->done( @result ) + May also be called as a class method, where it will construct a new + Future and immediately mark it as done. + + Returns the `$future' to allow easy chaining to create an immediate + future by + + return Future->done( ... ) + + $code = $future->done_cb + Returns a `CODE' reference that, when invoked, calls the `done' method. + This makes it simple to pass as a callback function to other code. + + As the same effect can be achieved using curry, this method is + deprecated now and may be removed in a later version. + + $code = $future->curry::done; + + $future->fail( $exception, @details ) + Marks that the leaf future has failed, and provides an exception value. + This exception will be thrown by the `get' method if called. + + The exception must evaluate as a true value; false exceptions are not + allowed. Further details may be provided that will be returned by the + `failure' method in list context. These details will not be part of the + exception string raised by `get'. + + If the future is already cancelled, this request is ignored. If the + future is already complete with a result or a failure, an exception is + thrown. + + Future->fail( $exception, @details ) + May also be called as a class method, where it will construct a new + Future and immediately mark it as failed. + + Returns the `$future' to allow easy chaining to create an immediate + failed future by + + return Future->fail( ... ) + + $code = $future->fail_cb + Returns a `CODE' reference that, when invoked, calls the `fail' method. + This makes it simple to pass as a callback function to other code. + + As the same effect can be achieved using curry, this method is + deprecated now and may be removed in a later version. + + $code = $future->curry::fail; + + $future->die( $message, @details ) + A convenient wrapper around `fail'. If the exception is a non-reference + that does not end in a linefeed, its value will be extended by the file + and line number of the caller, similar to the logic that `die' uses. + + Returns the `$future'. + + $future->on_cancel( $code ) + If the future is not yet ready, adds a callback to be invoked if the + future is cancelled by the `cancel' method. If the future is already + ready, throws an exception. + + If the future is cancelled, the callbacks will be invoked in the reverse + order to that in which they were registered. + + $on_cancel->( $future ) + + $future->on_cancel( $f ) + If passed another `Future' instance, the passed instance will be + cancelled when the original future is cancelled. This method does + nothing if the future is already complete. + + $cancelled = $future->is_cancelled + Returns true if the future has been cancelled by `cancel'. + +USER METHODS + These methods would primarily be used by users of asynchronous + interfaces, on objects returned by such an interface. + + $ready = $future->is_ready + Returns true on a leaf future if a result has been provided to the + `done' method, failed using the `fail' method, or cancelled using the + `cancel' method. + + Returns true on a convergent future if it is ready to yield a result, + depending on its component futures. + + $future->on_ready( $code ) + If the future is not yet ready, adds a callback to be invoked when the + future is ready. If the future is already ready, invokes it immediately. + + In either case, the callback will be passed the future object itself. + The invoked code can then obtain the list of results by calling the + `get' method. + + $on_ready->( $future ) + + Returns the `$future'. + + $future->on_ready( $f ) + If passed another `Future' instance, the passed instance will have its + `done', `fail' or `cancel' methods invoked when the original future + completes successfully, fails, or is cancelled respectively. + + $done = $future->is_done + Returns true on a future if it is ready and completed successfully. + Returns false if it is still pending, failed, or was cancelled. + + @result = $future->get + $result = $future->get + If the future is ready and completed successfully, returns the list of + results that had earlier been given to the `done' method on a leaf + future, or the list of component futures it was waiting for on a + convergent future. In scalar context it returns just the first result + value. + + If the future is ready but failed, this method raises as an exception + the failure string or object that was given to the `fail' method. + + If the future was cancelled an exception is thrown. + + If it is not yet ready and is not of a subclass that provides an `await' + method an exception is thrown. If it is subclassed to provide an `await' + method then this is used to wait for the future to be ready, before + returning the result or propagating its failure exception. + + @values = Future->unwrap( @values ) + If given a single argument which is a `Future' reference, this method + will call `get' on it and return the result. Otherwise, it returns the + list of values directly in list context, or the first value in scalar. + Since it involves an implicit `await', this method can only be used on + immediate futures or subclasses that implement `await'. + + This will ensure that an outgoing argument is definitely not a `Future', + and may be useful in such cases as adapting synchronous code to fit + asynchronous libraries that return `Future' instances. + + $future->on_done( $code ) + If the future is not yet ready, adds a callback to be invoked when the + future is ready, if it completes successfully. If the future completed + successfully, invokes it immediately. If it failed or was cancelled, it + is not invoked at all. + + The callback will be passed the result passed to the `done' method. + + $on_done->( @result ) + + Returns the `$future'. + + $future->on_done( $f ) + If passed another `Future' instance, the passed instance will have its + `done' method invoked when the original future completes successfully. + + $failed = $future->is_failed + Returns true on a future if it is ready and it failed. Returns false if + it is still pending, completed successfully, or was cancelled. + + $exception = $future->failure + $exception, @details = $future->failure + Returns the exception passed to the `fail' method, `undef' if the future + completed successfully via the `done' method, or raises an exception if + called on a future that is not yet ready. + + If called in list context, will additionally yield a list of the details + provided to the `fail' method. + + Because the exception value must be true, this can be used in a simple + `if' statement: + + if( my $exception = $future->failure ) { + ... + } + else { + my @result = $future->get; + ... + } + + $future->on_fail( $code ) + If the future is not yet ready, adds a callback to be invoked when the + future is ready, if it fails. If the future has already failed, invokes + it immediately. If it completed successfully or was cancelled, it is not + invoked at all. + + The callback will be passed the exception and details passed to the + `fail' method. + + $on_fail->( $exception, @details ) + + Returns the `$future'. + + $future->on_fail( $f ) + If passed another `Future' instance, the passed instance will have its + `fail' method invoked when the original future fails. + + To invoke a `done' method on a future when another one fails, use a CODE + reference: + + $future->on_fail( sub { $f->done( @_ ) } ); + + $future->cancel + Requests that the future be cancelled, immediately marking it as ready. + This will invoke all of the code blocks registered by `on_cancel', in + the reverse order. When called on a convergent future, all its component + futures are also cancelled. It is not an error to attempt to cancel a + future that is already complete or cancelled; it simply has no effect. + + Returns the `$future'. + + $code = $future->cancel_cb + Returns a `CODE' reference that, when invoked, calls the `cancel' + method. This makes it simple to pass as a callback function to other + code. + + As the same effect can be achieved using curry, this method is + deprecated now and may be removed in a later version. + + $code = $future->curry::cancel; + +SEQUENCING METHODS + The following methods all return a new future to represent the + combination of its invocant followed by another action given by a code + reference. The combined activity waits for the first future to be ready, + then may invoke the code depending on the success or failure of the + first, or may run it regardless. The returned sequence future represents + the entire combination of activity. + + In some cases the code should return a future; in some it should return + an immediate result. If a future is returned, the combined future will + then wait for the result of this second one. If the combinined future is + cancelled, it will cancel either the first future or the second, + depending whether the first had completed. If the code block throws an + exception instead of returning a value, the sequence future will fail + with that exception as its message and no further values. + + As it is always a mistake to call these sequencing methods in void + context and lose the reference to the returned future (because + exception/error handling would be silently dropped), this method warns + in void context. + + $future = $f1->then( \&done_code ) + Returns a new sequencing `Future' that runs the code if the first + succeeds. Once `$f1' succeeds the code reference will be invoked and is + passed the list of results. It should return a future, `$f2'. Once `$f2' + completes the sequence future will then be marked as complete with + whatever result `$f2' gave. If `$f1' fails then the sequence future will + immediately fail with the same failure and the code will not be invoked. + + $f2 = $done_code->( @result ) + + $future = $f1->else( \&fail_code ) + Returns a new sequencing `Future' that runs the code if the first fails. + Once `$f1' fails the code reference will be invoked and is passed the + failure and details. It should return a future, `$f2'. Once `$f2' + completes the sequence future will then be marked as complete with + whatever result `$f2' gave. If `$f1' succeeds then the sequence future + will immediately succeed with the same result and the code will not be + invoked. + + $f2 = $fail_code->( $exception, @details ) + + $future = $f1->then( \&done_code, \&fail_code ) + The `then' method can also be passed the `$fail_code' block as well, + giving a combination of `then' and `else' behaviour. + + This operation is designed to be compatible with the semantics of other + future systems, such as Javascript's Q or Promises/A libraries. + + $future = $f1->transform( %args ) + Returns a new sequencing `Future' that wraps the one given as `$f1'. + With no arguments this will be a trivial wrapper; `$future' will + complete or fail when `$f1' does, and `$f1' will be cancelled when + `$future' is. + + By passing the following named arguments, the returned `$future' can be + made to behave differently to `$f1': + + done => CODE + Provides a function to use to modify the result of a successful + completion. When `$f1' completes successfully, the result of its + `get' method is passed into this function, and whatever it + returns is passed to the `done' method of `$future' + + fail => CODE + Provides a function to use to modify the result of a failure. + When `$f1' fails, the result of its `failure' method is passed + into this function, and whatever it returns is passed to the + `fail' method of `$future'. + + $future = $f1->then_with_f( \&code ) + Returns a new sequencing `Future' that runs the code if the first + succeeds. Identical to `then', except that the code reference will be + passed both the original future, `$f1', and its result. + + $f2 = $code->( $f1, @result ) + + This is useful for conditional execution cases where the code block may + just return the same result of the original future. In this case it is + more efficient to return the original future itself. + + $future = $f->then_done( @result ) + $future = $f->then_fail( $exception, @details ) + Convenient shortcuts to returning an immediate future from a `then' + block, when the result is already known. + + $future = $f1->else_with_f( \&code ) + Returns a new sequencing `Future' that runs the code if the first fails. + Identical to `else', except that the code reference will be passed both + the original future, `$f1', and its exception and details. + + $f2 = $code->( $f1, $exception, @details ) + + This is useful for conditional execution cases where the code block may + just return the same result of the original future. In this case it is + more efficient to return the original future itself. + + $future = $f->else_done( @result ) + $future = $f->else_fail( $exception, @details ) + Convenient shortcuts to returning an immediate future from a `else' + block, when the result is already known. + + $future = $f1->followed_by( \&code ) + Returns a new sequencing `Future' that runs the code regardless of + success or failure. Once `$f1' is ready the code reference will be + invoked and is passed one argument, `$f1'. It should return a future, + `$f2'. Once `$f2' completes the sequence future will then be marked as + complete with whatever result `$f2' gave. + + $f2 = $code->( $f1 ) + + $future = $f1->without_cancel + Returns a new sequencing `Future' that will complete with the success or + failure of the original future, but if cancelled, will not cancel the + original. This may be useful if the original future represents an + operation that is being shared among multiple sequences; cancelling one + should not prevent the others from running too. + +CONVERGENT FUTURES + The following constructors all take a list of component futures, and + return a new future whose readiness somehow depends on the readiness of + those components. The first derived class component future will be used + as the prototype for constructing the return value, so it respects + subclassing correctly, or failing that a plain `Future'. + + $future = Future->wait_all( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once all + of the sub future objects given to it indicate that they are ready, + either by success, failure or cancellation. Its result will a list of + its component futures. + + When given an empty list this constructor returns a new immediately-done + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + + $future = Future->wait_any( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once any + of the sub future objects given to it indicate that they are ready, + either by success or failure. Any remaining component futures that are + not yet ready will be cancelled. Its result will be the result of the + first component future that was ready; either success or failure. Any + component futures that are cancelled are ignored, apart from the final + component left; at which point the result will be a failure. + + When given an empty list this constructor returns an immediately-failed + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + + $future = Future->needs_all( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once all + of the sub future objects given to it indicate that they have completed + successfully, or when any of them indicates that they have failed. If + any sub future fails, then this will fail immediately, and the remaining + subs not yet ready will be cancelled. Any component futures that are + cancelled will cause an immediate failure of the result. + + If successful, its result will be a concatenated list of the results of + all its component futures, in corresponding order. If it fails, its + failure will be that of the first component future that failed. To + access each component future's results individually, use `done_futures'. + + When given an empty list this constructor returns a new immediately-done + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + + $future = Future->needs_any( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once any + of the sub future objects given to it indicate that they have completed + successfully, or when all of them indicate that they have failed. If any + sub future succeeds, then this will succeed immediately, and the + remaining subs not yet ready will be cancelled. Any component futures + that are cancelled are ignored, apart from the final component left; at + which point the result will be a failure. + + If successful, its result will be that of the first component future + that succeeded. If it fails, its failure will be that of the last + component future to fail. To access the other failures, use + `failed_futures'. + + Normally when this future completes successfully, only one of its + component futures will be done. If it is constructed with multiple that + are already done however, then all of these will be returned from + `done_futures'. Users should be careful to still check all the results + from `done_futures' in that case. + + When given an empty list this constructor returns an immediately-failed + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + +METHODS ON CONVERGENT FUTURES + The following methods apply to convergent (i.e. non-leaf) futures, to + access the component futures stored by it. + + @f = $future->pending_futures + @f = $future->ready_futures + @f = $future->done_futures + @f = $future->failed_futures + @f = $future->cancelled_futures + Return a list of all the pending, ready, done, failed, or cancelled + component futures. In scalar context, each will yield the number of such + component futures. + +TRACING METHODS + $future = $future->set_label( $label ) + $label = $future->label + Chaining mutator and accessor for the label of the `Future'. This should + be a plain string value, whose value will be stored by the future + instance for use in debugging messages or other tooling, or similar + purposes. + + [ $sec, $usec ] = $future->btime + [ $sec, $usec ] = $future->rtime + Accessors that return the tracing timestamps from the instance. These + give the time the instance was contructed ("birth" time, `btime') and + the time the result was determined (the "ready" time, `rtime'). Each + result is returned as a two-element ARRAY ref, containing the epoch time + in seconds and microseconds, as given by `Time::HiRes::gettimeofday'. + + In order for these times to be captured, they have to be enabled by + setting `$Future::TIMES' to a true value. This is initialised true at + the time the module is loaded if either `PERL_FUTURE_DEBUG' or + `PERL_FUTURE_TIMES' are set in the environment. + + $sec = $future->elapsed + If both tracing timestamps are defined, returns the number of seconds of + elapsed time between them as a floating-point number. If not, returns + `undef'. + + $cb = $future->wrap_cb( $operation_name, $cb ) + *Since version 0.31.* + + *Note: This method is experimental and may be changed or removed in a + later version.* + + This method is invoked internally by various methods that are about to + save a callback CODE reference supplied by the user, to be invoked + later. The default implementation simply returns the callback agument + as-is; the method is provided to allow users to provide extra behaviour. + This can be done by applying a method modifier of the `around' kind, so + in effect add a chain of wrappers. Each wrapper can then perform its own + wrapping logic of the callback. `$operation_name' is a string giving the + reason for which the callback is being saved; currently one of + `on_ready', `on_done', `on_fail' or `sequence'; the latter being used + for all the sequence-returning methods. + + This method is intentionally invoked only for CODE references that are + being saved on a pending `Future' instance to be invoked at some later + point. It does not run for callbacks to be invoked on an + already-complete instance. This is for performance reasons, where the + intended behaviour is that the wrapper can provide some amount of + context save and restore, to return the operating environment for the + callback back to what it was at the time it was saved. + + For example, the following wrapper saves the value of a package variable + at the time the callback was saved, and restores that value at + invocation time later on. This could be useful for preserving context + during logging in a Future-based program. + + our $LOGGING_CTX; + + no warnings 'redefine'; + + my $orig = Future->can( "wrap_cb" ); + *Future::wrap_cb = sub { + my $cb = $orig->( @_ ); + + my $saved_logging_ctx = $LOGGING_CTX; + + return sub { + local $LOGGING_CTX = $saved_logging_ctx; + $cb->( @_ ); + }; + }; + + At this point, any code deferred into a `Future' by any of its callbacks + will observe the `$LOGGING_CTX' variable as having the value it held at + the time the callback was saved, even if it is invoked later on when + that value is different. + + Remember when writing such a wrapper, that it still needs to invoke the + previous version of the method, so that it plays nicely in combination + with others (see the `$orig->( @_ )' part). + +EXAMPLES + The following examples all demonstrate possible uses of a `Future' + object to provide a fictional asynchronous API. + + For more examples, comparing the use of `Future' with regular + call/return style Perl code, see also Future::Phrasebook. + + Providing Results + By returning a new `Future' object each time the asynchronous function + is called, it provides a placeholder for its eventual result, and a way + to indicate when it is complete. + + sub foperation + { + my %args = @_; + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => sub { $future->done( @_ ); }, + ); + + return $future; + } + + In most cases, the `done' method will simply be invoked with the entire + result list as its arguments. In that case, it is simpler to use the + `done_cb' wrapper method to create the `CODE' reference. + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => $future->done_cb, + ); + + The caller may then use this future to wait for a result using the + `on_ready' method, and obtain the result using `get'. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + say "The operation returned: ", $f->get; + } ); + + Indicating Success or Failure + Because the stored exception value of a failed future may not be false, + the `failure' method can be used in a conditional statement to detect + success or failure. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + if( not my $e = $f->failure ) { + say "The operation succeeded with: ", $f->get; + } + else { + say "The operation failed with: ", $e; + } + } ); + + By using `not' in the condition, the order of the `if' blocks can be + arranged to put the successful case first, similar to a `try'/`catch' + block. + + Because the `get' method re-raises the passed exception if the future + failed, it can be used to control a `try'/`catch' block directly. (This + is sometimes called *Exception Hoisting*). + + use Try::Tiny; + + $f->on_ready( sub { + my $f = shift; + try { + say "The operation succeeded with: ", $f->get; + } + catch { + say "The operation failed with: ", $_; + }; + } ); + + Even neater still may be the separate use of the `on_done' and `on_fail' + methods. + + $f->on_done( sub { + my @result = @_; + say "The operation succeeded with: ", @result; + } ); + $f->on_fail( sub { + my ( $failure ) = @_; + say "The operation failed with: $failure"; + } ); + + Immediate Futures + Because the `done' method returns the future object itself, it can be + used to generate a `Future' that is immediately ready with a result. + This can also be used as a class method. + + my $f = Future->done( $value ); + + Similarly, the `fail' and `die' methods can be used to generate a + `Future' that is immediately failed. + + my $f = Future->die( "This is never going to work" ); + + This could be considered similarly to a `die' call. + + An `eval{}' block can be used to turn a `Future'-returning function that + might throw an exception, into a `Future' that would indicate this + failure. + + my $f = eval { function() } || Future->fail( $@ ); + + This is neater handled by the `call' class method, which wraps the call + in an `eval{}' block and tests the result: + + my $f = Future->call( \&function ); + + Sequencing + The `then' method can be used to create simple chains of dependent + tasks, each one executing and returning a `Future' when the previous + operation succeeds. + + my $f = do_first() + ->then( sub { + return do_second(); + }) + ->then( sub { + return do_third(); + }); + + The result of the `$f' future itself will be the result of the future + returned by the final function, if none of them failed. If any of them + fails it will fail with the same failure. This can be considered similar + to normal exception handling in synchronous code; the first time a + function call throws an exception, the subsequent calls are not made. + + Merging Control Flow + A `wait_all' future may be used to resynchronise control flow, while + waiting for multiple concurrent operations to finish. + + my $f1 = foperation( foo => "something" ); + my $f2 = foperation( bar => "something else" ); + + my $f = Future->wait_all( $f1, $f2 ); + + $f->on_ready( sub { + say "Operations are ready:"; + say " foo: ", $f1->get; + say " bar: ", $f2->get; + } ); + + This provides an ability somewhat similar to `CPS::kpar()' or + Async::MergePoint. + +KNOWN ISSUES + Cancellation of Non-Final Sequence Futures + The behaviour of future cancellation still has some unanswered questions + regarding how to handle the situation where a future is cancelled that + has a sequence future constructed from it. + + In particular, it is unclear in each of the following examples what the + behaviour of `$f2' should be, were `$f1' to be cancelled: + + $f2 = $f1->then( sub { ... } ); # plus related ->then_with_f, ... + + $f2 = $f1->else( sub { ... } ); # plus related ->else_with_f, ... + + $f2 = $f1->followed_by( sub { ... } ); + + In the `then'-style case it is likely that this situation should be + treated as if `$f1' had failed, perhaps with some special message. The + `else'-style case is more complex, because it may be that the entire + operation should still fail, or it may be that the cancellation of `$f1' + should again be treated simply as a special kind of failure, and the + `else' logic run as normal. + + To be specific; in each case it is unclear what happens if the first + future is cancelled, while the second one is still waiting on it. The + semantics for "normal" top-down cancellation of `$f2' and how it affects + `$f1' are already clear and defined. + + Cancellation of Divergent Flow + A further complication of cancellation comes from the case where a given + future is reused multiple times for multiple sequences or convergent + trees. + + In particular, it is in clear in each of the following examples what the + behaviour of `$f2' should be, were `$f1' to be cancelled: + + my $f_initial = Future->new; ... + my $f1 = $f_initial->then( ... ); + my $f2 = $f_initial->then( ... ); + + my $f1 = Future->needs_all( $f_initial ); + my $f2 = Future->needs_all( $f_initial ); + + The point of cancellation propagation is to trace backwards through + stages of some larger sequence of operations that now no longer need to + happen, because the final result is no longer required. But in each of + these cases, just because `$f1' has been cancelled, the initial future + `$f_initial' is still required because there is another future (`$f2') + that will still require its result. + + Initially it would appear that some kind of reference-counting mechanism + could solve this question, though that itself is further complicated by + the `on_ready' handler and its variants. + + It may simply be that a comprehensive useful set of cancellation + semantics can't be universally provided to cover all cases; and that + some use-cases at least would require the application logic to give + extra information to its `Future' objects on how they should wire up the + cancel propagation logic. + + Both of these cancellation issues are still under active design + consideration; see the discussion on RT96685 for more information + (https://rt.cpan.org/Ticket/Display.html?id=96685). + +SEE ALSO + * curry - Create automatic curried method call closures for any class + or object + + * "The Past, The Present and The Future" - slides from a talk given at + the London Perl Workshop, 2012. + + https://docs.google.com/presentation/d/1UkV5oLcTOOXBXPh8foyxko4PR28_ + zU_aVx6gBms7uoo/edit + + * "Futures advent calendar 2013" + + http://leonerds-code.blogspot.co.uk/2013/12/futures-advent-day-1.htm + l + +TODO + * Consider the ability to pass the constructor an `await' CODEref, + instead of needing to use a subclass. This might simplify + async/etc.. implementations, and allows the reuse of the idea of + subclassing to extend the abilities of `Future' itself - for example + to allow a kind of Future that can report incremental progress. + +AUTHOR + Paul Evans <leonerd@leonerd.org.uk> + diff --git a/examples/io-async.pl b/examples/io-async.pl new file mode 100644 index 0000000..7763db1 --- /dev/null +++ b/examples/io-async.pl @@ -0,0 +1,9 @@ +use IO::Async::Loop 0.56; # Already has Future support built-in ;) + +my $loop = IO::Async::Loop->new; + +my $timer = $loop->delay_future( after => 3 ); +print "Awaiting 3 seconds...\n"; + +$timer->get; +print "Done\n"; diff --git a/lib/Future.pm b/lib/Future.pm new file mode 100644 index 0000000..07d7490 --- /dev/null +++ b/lib/Future.pm @@ -0,0 +1,2200 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2011-2015 -- leonerd@leonerd.org.uk + +package Future; + +use strict; +use warnings; +no warnings 'recursion'; # Disable the "deep recursion" warning + +our $VERSION = '0.32'; + +use Carp qw(); # don't import croak +use Scalar::Util qw( weaken blessed reftype ); +use B qw( svref_2object ); +use Time::HiRes qw( gettimeofday tv_interval ); + +# we are not overloaded, but we want to check if other objects are +require overload; + +our @CARP_NOT = qw( Future::Utils ); + +use constant DEBUG => $ENV{PERL_FUTURE_DEBUG}; + +our $TIMES = DEBUG || $ENV{PERL_FUTURE_TIMES}; + +=head1 NAME + +C<Future> - represent an operation awaiting completion + +=head1 SYNOPSIS + + my $future = Future->new; + + perform_some_operation( + on_complete => sub { + $future->done( @_ ); + } + ); + + $future->on_ready( sub { + say "The operation is complete"; + } ); + +=head1 DESCRIPTION + +A C<Future> object represents an operation that is currently in progress, or +has recently completed. It can be used in a variety of ways to manage the flow +of control, and data, through an asynchronous program. + +Some futures represent a single operation and are explicitly marked as ready +by calling the C<done> or C<fail> methods. These are called "leaf" futures +here, and are returned by the C<new> constructor. + +Other futures represent a collection of sub-tasks, and are implicitly marked +as ready depending on the readiness of their component futures as required. +These are called "convergent" futures here as they converge control and +data-flow back into one place. These are the ones returned by the various +C<wait_*> and C<need_*> constructors. + +It is intended that library functions that perform asynchronous operations +would use future objects to represent outstanding operations, and allow their +calling programs to control or wait for these operations to complete. The +implementation and the user of such an interface would typically make use of +different methods on the class. The methods below are documented in two +sections; those of interest to each side of the interface. + +It should be noted however, that this module does not in any way provide an +actual mechanism for performing this asynchronous activity; it merely provides +a way to create objects that can be used for control and data flow around +those operations. It allows such code to be written in a neater, +forward-reading manner, and simplifies many common patterns that are often +involved in such situations. + +See also L<Future::Utils> which contains useful loop-constructing functions, +to run a future-returning function repeatedly in a loop. + +=head2 SUBCLASSING + +This class easily supports being subclassed to provide extra behavior, such as +giving the C<get> method the ability to block and wait for completion. This +may be useful to provide C<Future> subclasses with event systems, or similar. + +Each method that returns a new future object will use the invocant to +construct its return value. If the constructor needs to perform per-instance +setup it can override the C<new> method, and take context from the given +instance. + + sub new + { + my $proto = shift; + my $self = $proto->SUPER::new; + + if( ref $proto ) { + # Prototype was an instance + } + else { + # Prototype was a class + } + + return $self; + } + +If an instance provides a method called C<await>, this will be called by the +C<get> and C<failure> methods if the instance is pending. + + $f->await + +In most cases this should allow future-returning modules to be used as if they +were blocking call/return-style modules, by simply appending a C<get> call to +the function or method calls. + + my ( $results, $here ) = future_returning_function( @args )->get; + +The F<examples> directory in the distribution contains some examples of how +futures might be integrated with various event systems. + +=head2 MODULE DOCUMENTATION + +Modules that provide future-returning functions or methods may wish to adopt +the following styles in some way, to document the eventual return values from +these futures. + + func( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + OBJ->method( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + +Code returning a future that yields no values on success can use empty +parentheses. + + func( ... ) ==> () + +=head2 DEBUGGING + +By the time a C<Future> object is destroyed, it ought to have been completed +or cancelled. By enabling debug tracing of objects, this fact can be checked. +If a future object is destroyed without having been completed or cancelled, a +warning message is printed. + + + $ PERL_FUTURE_DEBUG=1 perl -MFuture -E 'my $f = Future->new' + Future=HASH(0xaa61f8) was constructed at -e line 1 and was lost near -e line 0 before it was ready. + +Note that due to a limitation of perl's C<caller> function within a C<DESTROY> +destructor method, the exact location of the leak cannot be accurately +determined. Often the leak will occur due to falling out of scope by returning +from a function; in this case the leak location may be reported as being the +line following the line calling that function. + + $ PERL_FUTURE_DEBUG=1 perl -MFuture + sub foo { + my $f = Future->new; + } + + foo(); + print "Finished\n"; + + Future=HASH(0x14a2220) was constructed at - line 2 and was lost near - line 6 before it was ready. + Finished + +A warning is also printed in debug mode if a C<Future> object is destroyed +that completed with a failure, but the object believes that failure has not +been reported anywhere. + + $ PERL_FUTURE_DEBUG=1 perl -Mblib -MFuture -E 'my $f = Future->fail("Oops")' + Future=HASH(0xac98f8) was constructed at -e line 1 and was lost near -e line 0 with an unreported failure of: Oops + +Such a failure is considered reported if the C<get> or C<failure> methods are +called on it, or it had at least one C<on_ready> or C<on_fail> callback, or +its failure is propagated to another C<Future> instance (by a sequencing or +converging method). + +=cut + +=head1 CONSTRUCTORS + +=cut + +=head2 $future = Future->new + +=head2 $future = $orig->new + +Returns a new C<Future> instance to represent a leaf future. It will be marked +as ready by any of the C<done>, C<fail>, or C<cancel> methods. It can be +called either as a class method, or as an instance method. Called on an +instance it will construct another in the same class, and is useful for +subclassing. + +This constructor would primarily be used by implementations of asynchronous +interfaces. + +=cut + +# Callback flags +use constant { + CB_DONE => 1<<0, # Execute callback on done + CB_FAIL => 1<<1, # Execute callback on fail + CB_CANCEL => 1<<2, # Execute callback on cancellation + + CB_SELF => 1<<3, # Pass $self as first argument + CB_RESULT => 1<<4, # Pass result/failure as a list + + CB_SEQ_ONDONE => 1<<5, # Sequencing on success (->then) + CB_SEQ_ONFAIL => 1<<6, # Sequencing on failure (->else) + + CB_SEQ_IMDONE => 1<<7, # $code is in fact immediate ->done result + CB_SEQ_IMFAIL => 1<<8, # $code is in fact immediate ->fail result +}; + +use constant CB_ALWAYS => CB_DONE|CB_FAIL|CB_CANCEL; + +# Useful for identifying CODE references +sub CvNAME_FILE_LINE +{ + my ( $code ) = @_; + my $cv = svref_2object( $code ); + + my $name = join "::", $cv->STASH->NAME, $cv->GV->NAME; + return $name unless $cv->GV->NAME eq "__ANON__"; + + # $cv->GV->LINE isn't reliable, as outside of perl -d mode all anon CODE + # in the same file actually shares the same GV. :( + # Walk the optree looking for the first COP + my $cop = $cv->START; + $cop = $cop->next while $cop and ref $cop ne "B::COP"; + + sprintf "%s(%s line %d)", $cv->GV->NAME, $cop->file, $cop->line; +} + +sub _callable +{ + my ( $cb ) = @_; + defined $cb and ( reftype($cb) eq 'CODE' || overload::Method($cb, '&{}') ); +} + +sub new +{ + my $proto = shift; + return bless { + ready => 0, + callbacks => [], # [] = [$type, ...] + ( DEBUG ? + ( do { my $at = Carp::shortmess( "constructed" ); + chomp $at; $at =~ s/\.$//; + constructed_at => $at } ) + : () ), + ( $TIMES ? + ( btime => [ gettimeofday ] ) + : () ), + }, ( ref $proto || $proto ); +} + +my $GLOBAL_END; +END { $GLOBAL_END = 1; } + +sub DESTROY_debug { + my $self = shift; + return if $GLOBAL_END; + return if $self->{ready} and ( $self->{reported} or !$self->{failure} ); + + my $lost_at = join " line ", (caller)[1,2]; + # We can't actually know the real line where the last reference was lost; + # a variable set to 'undef' or close of scope, because caller can't see it; + # the current op has already been updated. The best we can do is indicate + # 'near'. + + if( $self->{ready} and $self->{failure} ) { + warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at with an unreported failure of: " . + $self->{failure}[0] . "\n"; + } + elsif( !$self->{ready} ) { + warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at before it was ready.\n"; + } +} +*DESTROY = \&DESTROY_debug if DEBUG; + +=head2 $future = Future->done( @values ) + +=head2 $future = Future->fail( $exception, @details ) + +Shortcut wrappers around creating a new C<Future> then immediately marking it +as done or failed. + +=head2 $future = Future->wrap( @values ) + +If given a single argument which is already a C<Future> reference, this will +be returned unmodified. Otherwise, returns a new C<Future> instance that is +already complete, and will yield the given values. + +This will ensure that an incoming argument is definitely a C<Future>, and may +be useful in such cases as adapting synchronous code to fit asynchronous +libraries driven by C<Future>. + +=cut + +sub wrap +{ + my $class = shift; + my @values = @_; + + if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) { + return $values[0]; + } + else { + return $class->done( @values ); + } +} + +=head2 $future = Future->call( \&code, @args ) + +A convenient wrapper for calling a C<CODE> reference that is expected to +return a future. In normal circumstances is equivalent to + + $future = $code->( @args ) + +except that if the code throws an exception, it is wrapped in a new immediate +fail future. If the return value from the code is not a blessed C<Future> +reference, an immediate fail future is returned instead to complain about this +fact. + +=cut + +sub call +{ + my $class = shift; + my ( $code, @args ) = @_; + + my $f; + eval { $f = $code->( @args ); 1 } or $f = $class->fail( $@ ); + blessed $f and $f->isa( "Future" ) or $f = $class->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); + + return $f; +} + +sub _shortmess +{ + my $at = Carp::shortmess( $_[0] ); + chomp $at; $at =~ s/\.$//; + return $at; +} + +sub _mark_ready +{ + my $self = shift; + $self->{ready} = 1; + $self->{ready_at} = _shortmess $_[0] if DEBUG; + + if( $TIMES ) { + $self->{rtime} = [ gettimeofday ]; + } + + delete $self->{on_cancel}; + my $callbacks = delete $self->{callbacks} or return; + + my $cancelled = $self->{cancelled}; + my $fail = defined $self->{failure}; + my $done = !$fail && !$cancelled; + + my @result = $done ? $self->get : + $fail ? $self->failure : + (); + + foreach my $cb ( @$callbacks ) { + my ( $flags, $code ) = @$cb; + my $is_future = blessed( $code ) && $code->isa( "Future" ); + + next if $done and not( $flags & CB_DONE ); + next if $fail and not( $flags & CB_FAIL ); + next if $cancelled and not( $flags & CB_CANCEL ); + + $self->{reported} = 1 if $fail; + + if( $is_future ) { + $done ? $code->done( @result ) : + $fail ? $code->fail( @result ) : + $code->cancel; + } + elsif( $flags & (CB_SEQ_ONDONE|CB_SEQ_ONFAIL) ) { + my ( undef, undef, $fseq ) = @$cb; + if( !$fseq ) { # weaken()ed; it might be gone now + # This warning should always be printed, even not in DEBUG mode. + # It's always an indication of a bug + Carp::carp +(DEBUG ? "${\$self->__selfstr} ($self->{constructed_at})" + : "${\$self->__selfstr} $self" ) . + " lost a sequence Future"; + next; + } + + my $f2; + if( $done and $flags & CB_SEQ_ONDONE or + $fail and $flags & CB_SEQ_ONFAIL ) { + + if( $flags & CB_SEQ_IMDONE ) { + $fseq->done( @$code ); + next; + } + elsif( $flags & CB_SEQ_IMFAIL ) { + $fseq->fail( @$code ); + next; + } + + my @args = ( + ( $flags & CB_SELF ? $self : () ), + ( $flags & CB_RESULT ? @result : () ), + ); + + unless( eval { $f2 = $code->( @args ); 1 } ) { + $fseq->fail( $@ ); + next; + } + + unless( blessed $f2 and $f2->isa( "Future" ) ) { + $fseq->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); + next; + } + + $fseq->on_cancel( $f2 ); + } + else { + $f2 = $self; + } + + if( $f2->is_ready ) { + $f2->on_ready( $fseq ) if !$f2->{cancelled}; + } + else { + push @{ $f2->{callbacks} }, [ CB_DONE|CB_FAIL, $fseq ]; + weaken( $f2->{callbacks}[-1][1] ); + } + } + else { + $code->( + ( $flags & CB_SELF ? $self : () ), + ( $flags & CB_RESULT ? @result : () ), + ); + } + } +} + +sub _state +{ + my $self = shift; + return !$self->{ready} ? "pending" : + DEBUG ? $self->{ready_at} : + $self->{failure} ? "failed" : + $self->{cancelled} ? "cancelled" : + "done"; +} + +=head1 IMPLEMENTATION METHODS + +These methods would primarily be used by implementations of asynchronous +interfaces. + +=cut + +=head2 $future->done( @result ) + +Marks that the leaf future is now ready, and provides a list of values as a +result. (The empty list is allowed, and still indicates the future as ready). +Cannot be called on a convergent future. + +If the future is already cancelled, this request is ignored. If the future is +already complete with a result or a failure, an exception is thrown. + +=head2 Future->done( @result ) + +May also be called as a class method, where it will construct a new Future and +immediately mark it as done. + +Returns the C<$future> to allow easy chaining to create an immediate future by + + return Future->done( ... ) + +=cut + +sub done +{ + my $self = shift; + + if( ref $self ) { + $self->{cancelled} and return $self; + $self->{ready} and Carp::croak "${\$self->__selfstr} is already ".$self->_state." and cannot be ->done"; + $self->{subs} and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->done"; + $self->{result} = [ @_ ]; + $self->_mark_ready( "done" ); + } + else { + $self = $self->new; + $self->{ready} = 1; + $self->{ready_at} = _shortmess "done" if DEBUG; + $self->{result} = [ @_ ]; + } + + return $self; +} + +=head2 $code = $future->done_cb + +Returns a C<CODE> reference that, when invoked, calls the C<done> method. This +makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L<curry>, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::done; + +=cut + +sub done_cb +{ + my $self = shift; + return sub { $self->done( @_ ) }; +} + +=head2 $future->fail( $exception, @details ) + +Marks that the leaf future has failed, and provides an exception value. This +exception will be thrown by the C<get> method if called. + +The exception must evaluate as a true value; false exceptions are not allowed. +Further details may be provided that will be returned by the C<failure> method +in list context. These details will not be part of the exception string raised +by C<get>. + +If the future is already cancelled, this request is ignored. If the future is +already complete with a result or a failure, an exception is thrown. + +=head2 Future->fail( $exception, @details ) + +May also be called as a class method, where it will construct a new Future and +immediately mark it as failed. + +Returns the C<$future> to allow easy chaining to create an immediate failed +future by + + return Future->fail( ... ) + +=cut + +sub fail +{ + my $self = shift; + my ( $exception, @details ) = @_; + + $_[0] or Carp::croak "$self ->fail requires an exception that is true"; + + if( ref $self ) { + $self->{cancelled} and return $self; + $self->{ready} and Carp::croak "${\$self->__selfstr} is already ".$self->_state." and cannot be ->fail'ed"; + $self->{subs} and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->fail'ed"; + $self->{failure} = [ $exception, @details ]; + $self->_mark_ready( "fail" ); + } + else { + $self = $self->new; + $self->{ready} = 1; + $self->{ready_at} = _shortmess "fail" if DEBUG; + $self->{failure} = [ $exception, @details ]; + } + + if( DEBUG ) { + my $at = Carp::shortmess( "failed" ); + chomp $at; $at =~ s/\.$//; + $self->{ready_at} = $at; + } + + return $self; +} + +=head2 $code = $future->fail_cb + +Returns a C<CODE> reference that, when invoked, calls the C<fail> method. This +makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L<curry>, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::fail; + +=cut + +sub fail_cb +{ + my $self = shift; + return sub { $self->fail( @_ ) }; +} + +=head2 $future->die( $message, @details ) + +A convenient wrapper around C<fail>. If the exception is a non-reference that +does not end in a linefeed, its value will be extended by the file and line +number of the caller, similar to the logic that C<die> uses. + +Returns the C<$future>. + +=cut + +sub die :method +{ + my $self = shift; + my ( $exception, @details ) = @_; + + if( !ref $exception and $exception !~ m/\n$/ ) { + $exception .= sprintf " at %s line %d\n", (caller)[1,2]; + } + + $self->fail( $exception, @details ); +} + +=head2 $future->on_cancel( $code ) + +If the future is not yet ready, adds a callback to be invoked if the future is +cancelled by the C<cancel> method. If the future is already ready, throws an +exception. + +If the future is cancelled, the callbacks will be invoked in the reverse order +to that in which they were registered. + + $on_cancel->( $future ) + +=head2 $future->on_cancel( $f ) + +If passed another C<Future> instance, the passed instance will be cancelled +when the original future is cancelled. This method does nothing if the future +is already complete. + +=cut + +sub on_cancel +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_cancel"; + + $self->{ready} and return $self; + + push @{ $self->{on_cancel} }, $code; + + return $self; +} + +=head2 $cancelled = $future->is_cancelled + +Returns true if the future has been cancelled by C<cancel>. + +=cut + +sub is_cancelled +{ + my $self = shift; + return $self->{cancelled}; +} + +=head1 USER METHODS + +These methods would primarily be used by users of asynchronous interfaces, on +objects returned by such an interface. + +=cut + +=head2 $ready = $future->is_ready + +Returns true on a leaf future if a result has been provided to the C<done> +method, failed using the C<fail> method, or cancelled using the C<cancel> +method. + +Returns true on a convergent future if it is ready to yield a result, +depending on its component futures. + +=cut + +sub is_ready +{ + my $self = shift; + return $self->{ready}; +} + +=head2 $future->on_ready( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +is ready. If the future is already ready, invokes it immediately. + +In either case, the callback will be passed the future object itself. The +invoked code can then obtain the list of results by calling the C<get> method. + + $on_ready->( $future ) + +Returns the C<$future>. + +=head2 $future->on_ready( $f ) + +If passed another C<Future> instance, the passed instance will have its +C<done>, C<fail> or C<cancel> methods invoked when the original future +completes successfully, fails, or is cancelled respectively. + +=cut + +sub on_ready +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_ready"; + + if( $self->{ready} ) { + my $fail = defined $self->{failure}; + my $done = !$fail && !$self->{cancelled}; + + $self->{reported} = 1 if $fail; + + $is_future ? ( $done ? $code->done( $self->get ) : + $fail ? $code->fail( $self->failure ) : + $code->cancel ) + : $code->( $self ); + } + else { + push @{ $self->{callbacks} }, [ CB_ALWAYS|CB_SELF, $self->wrap_cb( on_ready => $code ) ]; + } + + return $self; +} + +=head2 $done = $future->is_done + +Returns true on a future if it is ready and completed successfully. Returns +false if it is still pending, failed, or was cancelled. + +=cut + +sub is_done +{ + my $self = shift; + return $self->{ready} && !$self->{failure} && !$self->{cancelled}; +} + +=head2 @result = $future->get + +=head2 $result = $future->get + +If the future is ready and completed successfully, returns the list of +results that had earlier been given to the C<done> method on a leaf future, +or the list of component futures it was waiting for on a convergent future. In +scalar context it returns just the first result value. + +If the future is ready but failed, this method raises as an exception the +failure string or object that was given to the C<fail> method. + +If the future was cancelled an exception is thrown. + +If it is not yet ready and is not of a subclass that provides an C<await> +method an exception is thrown. If it is subclassed to provide an C<await> +method then this is used to wait for the future to be ready, before returning +the result or propagating its failure exception. + +=cut + +sub await +{ + my $self = shift; + Carp::croak "$self is not yet complete and does not provide ->await"; +} + +sub get +{ + my $self = shift; + $self->await until $self->{ready}; + if( $self->{failure} ) { + $self->{reported} = 1; + my $exception = $self->{failure}->[0]; + !ref $exception && $exception =~ m/\n$/ ? CORE::die $exception : Carp::croak $exception; + } + $self->{cancelled} and Carp::croak "${\$self->__selfstr} was cancelled"; + return $self->{result}->[0] unless wantarray; + return @{ $self->{result} }; +} + +=head2 @values = Future->unwrap( @values ) + +If given a single argument which is a C<Future> reference, this method will +call C<get> on it and return the result. Otherwise, it returns the list of +values directly in list context, or the first value in scalar. Since it +involves an implicit C<await>, this method can only be used on immediate +futures or subclasses that implement C<await>. + +This will ensure that an outgoing argument is definitely not a C<Future>, and +may be useful in such cases as adapting synchronous code to fit asynchronous +libraries that return C<Future> instances. + +=cut + +sub unwrap +{ + shift; # $class + my @values = @_; + + if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) { + return $values[0]->get; + } + else { + return $values[0] if !wantarray; + return @values; + } +} + +=head2 $future->on_done( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +is ready, if it completes successfully. If the future completed successfully, +invokes it immediately. If it failed or was cancelled, it is not invoked at +all. + +The callback will be passed the result passed to the C<done> method. + + $on_done->( @result ) + +Returns the C<$future>. + +=head2 $future->on_done( $f ) + +If passed another C<Future> instance, the passed instance will have its +C<done> method invoked when the original future completes successfully. + +=cut + +sub on_done +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_done"; + + if( $self->{ready} ) { + return $self if $self->{failure} or $self->{cancelled}; + + $is_future ? $code->done( $self->get ) + : $code->( $self->get ); + } + else { + push @{ $self->{callbacks} }, [ CB_DONE|CB_RESULT, $self->wrap_cb( on_done => $code ) ]; + } + + return $self; +} + +=head2 $failed = $future->is_failed + +Returns true on a future if it is ready and it failed. Returns false if it is +still pending, completed successfully, or was cancelled. + +=cut + +sub is_failed +{ + my $self = shift; + return $self->{ready} && !!$self->{failure}; # boolify +} + +=head2 $exception = $future->failure + +=head2 $exception, @details = $future->failure + +Returns the exception passed to the C<fail> method, C<undef> if the future +completed successfully via the C<done> method, or raises an exception if +called on a future that is not yet ready. + +If called in list context, will additionally yield a list of the details +provided to the C<fail> method. + +Because the exception value must be true, this can be used in a simple C<if> +statement: + + if( my $exception = $future->failure ) { + ... + } + else { + my @result = $future->get; + ... + } + +=cut + +sub failure +{ + my $self = shift; + $self->await until $self->{ready}; + return unless $self->{failure}; + $self->{reported} = 1; + return $self->{failure}->[0] if !wantarray; + return @{ $self->{failure} }; +} + +=head2 $future->on_fail( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +is ready, if it fails. If the future has already failed, invokes it +immediately. If it completed successfully or was cancelled, it is not invoked +at all. + +The callback will be passed the exception and details passed to the C<fail> +method. + + $on_fail->( $exception, @details ) + +Returns the C<$future>. + +=head2 $future->on_fail( $f ) + +If passed another C<Future> instance, the passed instance will have its +C<fail> method invoked when the original future fails. + +To invoke a C<done> method on a future when another one fails, use a CODE +reference: + + $future->on_fail( sub { $f->done( @_ ) } ); + +=cut + +sub on_fail +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_fail"; + + if( $self->{ready} ) { + return $self if not $self->{failure}; + $self->{reported} = 1; + + $is_future ? $code->fail( $self->failure ) + : $code->( $self->failure ); + } + else { + push @{ $self->{callbacks} }, [ CB_FAIL|CB_RESULT, $self->wrap_cb( on_fail => $code ) ]; + } + + return $self; +} + +=head2 $future->cancel + +Requests that the future be cancelled, immediately marking it as ready. This +will invoke all of the code blocks registered by C<on_cancel>, in the reverse +order. When called on a convergent future, all its component futures are also +cancelled. It is not an error to attempt to cancel a future that is already +complete or cancelled; it simply has no effect. + +Returns the C<$future>. + +=cut + +sub cancel +{ + my $self = shift; + + return $self if $self->{ready}; + + $self->{cancelled}++; + foreach my $code ( reverse @{ $self->{on_cancel} || [] } ) { + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future ? $code->cancel + : $code->( $self ); + } + $self->_mark_ready( "cancel" ); + + return $self; +} + +=head2 $code = $future->cancel_cb + +Returns a C<CODE> reference that, when invoked, calls the C<cancel> method. +This makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L<curry>, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::cancel; + +=cut + +sub cancel_cb +{ + my $self = shift; + return sub { $self->cancel }; +} + +=head1 SEQUENCING METHODS + +The following methods all return a new future to represent the combination of +its invocant followed by another action given by a code reference. The +combined activity waits for the first future to be ready, then may invoke the +code depending on the success or failure of the first, or may run it +regardless. The returned sequence future represents the entire combination of +activity. + +In some cases the code should return a future; in some it should return an +immediate result. If a future is returned, the combined future will then wait +for the result of this second one. If the combinined future is cancelled, it +will cancel either the first future or the second, depending whether the first +had completed. If the code block throws an exception instead of returning a +value, the sequence future will fail with that exception as its message and no +further values. + +As it is always a mistake to call these sequencing methods in void context and lose the +reference to the returned future (because exception/error handling would be +silently dropped), this method warns in void context. + +=cut + +sub _sequence +{ + my $f1 = shift; + my ( $code, $flags ) = @_; + + # For later, we might want to know where we were called from + my $func = (caller 1)[3]; + $func =~ s/^.*:://; + + $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL) or _callable( $code ) or + Carp::croak "Expected \$code to be callable in ->$func"; + + if( !defined wantarray ) { + Carp::carp "Calling ->$func in void context"; + } + + if( $f1->is_ready ) { + # Take a shortcut + return $f1 if $f1->is_done and not( $flags & CB_SEQ_ONDONE ) or + $f1->failure and not( $flags & CB_SEQ_ONFAIL ); + + if( $flags & CB_SEQ_IMDONE ) { + return Future->done( @$code ); + } + elsif( $flags & CB_SEQ_IMFAIL ) { + return Future->fail( @$code ); + } + + my @args = ( + ( $flags & CB_SELF ? $f1 : () ), + ( $flags & CB_RESULT ? $f1->is_done ? $f1->get : + $f1->failure ? $f1->failure : + () : () ), + ); + + my $fseq; + unless( eval { $fseq = $code->( @args ); 1 } ) { + return Future->fail( $@ ); + } + + unless( blessed $fseq and $fseq->isa( "Future" ) ) { + return Future->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); + } + + return $fseq; + } + + my $fseq = $f1->new; + $fseq->on_cancel( $f1 ); + + # TODO: if anyone cares about the op name, we might have to synthesize it + # from $flags + $code = $f1->wrap_cb( sequence => $code ) unless $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL); + + push @{ $f1->{callbacks} }, [ CB_DONE|CB_FAIL|$flags, $code, $fseq ]; + weaken( $f1->{callbacks}[-1][2] ); + + return $fseq; +} + +=head2 $future = $f1->then( \&done_code ) + +Returns a new sequencing C<Future> that runs the code if the first succeeds. +Once C<$f1> succeeds the code reference will be invoked and is passed the list +of results. It should return a future, C<$f2>. Once C<$f2> completes the +sequence future will then be marked as complete with whatever result C<$f2> +gave. If C<$f1> fails then the sequence future will immediately fail with the +same failure and the code will not be invoked. + + $f2 = $done_code->( @result ) + +=head2 $future = $f1->else( \&fail_code ) + +Returns a new sequencing C<Future> that runs the code if the first fails. Once +C<$f1> fails the code reference will be invoked and is passed the failure and +details. It should return a future, C<$f2>. Once C<$f2> completes the sequence +future will then be marked as complete with whatever result C<$f2> gave. If +C<$f1> succeeds then the sequence future will immediately succeed with the +same result and the code will not be invoked. + + $f2 = $fail_code->( $exception, @details ) + +=head2 $future = $f1->then( \&done_code, \&fail_code ) + +The C<then> method can also be passed the C<$fail_code> block as well, giving +a combination of C<then> and C<else> behaviour. + +This operation is designed to be compatible with the semantics of other future +systems, such as Javascript's Q or Promises/A libraries. + +=cut + +sub then +{ + my $self = shift; + my ( $done_code, $fail_code ) = @_; + + if( $done_code and !$fail_code ) { + return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_RESULT ); + } + + !$done_code or _callable( $done_code ) or + Carp::croak "Expected \$done_code to be callable in ->then"; + !$fail_code or _callable( $fail_code ) or + Carp::croak "Expected \$fail_code to be callable in ->then"; + + # Complex + return $self->_sequence( sub { + my $self = shift; + if( !$self->{failure} ) { + return $self unless $done_code; + return $done_code->( $self->get ); + } + else { + return $self unless $fail_code; + return $fail_code->( $self->failure ); + } + }, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); +} + +sub else +{ + my $self = shift; + my ( $fail_code ) = @_; + + return $self->_sequence( $fail_code, CB_SEQ_ONFAIL|CB_RESULT ); +} + +=head2 $future = $f1->transform( %args ) + +Returns a new sequencing C<Future> that wraps the one given as C<$f1>. With no +arguments this will be a trivial wrapper; C<$future> will complete or fail +when C<$f1> does, and C<$f1> will be cancelled when C<$future> is. + +By passing the following named arguments, the returned C<$future> can be made +to behave differently to C<$f1>: + +=over 8 + +=item done => CODE + +Provides a function to use to modify the result of a successful completion. +When C<$f1> completes successfully, the result of its C<get> method is passed +into this function, and whatever it returns is passed to the C<done> method of +C<$future> + +=item fail => CODE + +Provides a function to use to modify the result of a failure. When C<$f1> +fails, the result of its C<failure> method is passed into this function, and +whatever it returns is passed to the C<fail> method of C<$future>. + +=back + +=cut + +sub transform +{ + my $self = shift; + my %args = @_; + + my $xfrm_done = $args{done}; + my $xfrm_fail = $args{fail}; + + return $self->_sequence( sub { + my $self = shift; + if( !$self->{failure} ) { + return $self unless $xfrm_done; + my @result = $xfrm_done->( $self->get ); + return $self->new->done( @result ); + } + else { + return $self unless $xfrm_fail; + my @failure = $xfrm_fail->( $self->failure ); + return $self->new->fail( @failure ); + } + }, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); +} + +=head2 $future = $f1->then_with_f( \&code ) + +Returns a new sequencing C<Future> that runs the code if the first succeeds. +Identical to C<then>, except that the code reference will be passed both the +original future, C<$f1>, and its result. + + $f2 = $code->( $f1, @result ) + +This is useful for conditional execution cases where the code block may just +return the same result of the original future. In this case it is more +efficient to return the original future itself. + +=cut + +sub then_with_f +{ + my $self = shift; + my ( $done_code ) = @_; + + return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_SELF|CB_RESULT ); +} + +=head2 $future = $f->then_done( @result ) + +=head2 $future = $f->then_fail( $exception, @details ) + +Convenient shortcuts to returning an immediate future from a C<then> block, +when the result is already known. + +=cut + +sub then_done +{ + my $self = shift; + my ( @result ) = @_; + return $self->_sequence( \@result, CB_SEQ_ONDONE|CB_SEQ_IMDONE ); +} + +sub then_fail +{ + my $self = shift; + my ( @failure ) = @_; + return $self->_sequence( \@failure, CB_SEQ_ONDONE|CB_SEQ_IMFAIL ); +} + +=head2 $future = $f1->else_with_f( \&code ) + +Returns a new sequencing C<Future> that runs the code if the first fails. +Identical to C<else>, except that the code reference will be passed both the +original future, C<$f1>, and its exception and details. + + $f2 = $code->( $f1, $exception, @details ) + +This is useful for conditional execution cases where the code block may just +return the same result of the original future. In this case it is more +efficient to return the original future itself. + +=cut + +sub else_with_f +{ + my $self = shift; + my ( $fail_code ) = @_; + + return $self->_sequence( $fail_code, CB_SEQ_ONFAIL|CB_SELF|CB_RESULT ); +} + +=head2 $future = $f->else_done( @result ) + +=head2 $future = $f->else_fail( $exception, @details ) + +Convenient shortcuts to returning an immediate future from a C<else> block, +when the result is already known. + +=cut + +sub else_done +{ + my $self = shift; + my ( @result ) = @_; + return $self->_sequence( \@result, CB_SEQ_ONFAIL|CB_SEQ_IMDONE ); +} + +sub else_fail +{ + my $self = shift; + my ( @failure ) = @_; + return $self->_sequence( \@failure, CB_SEQ_ONFAIL|CB_SEQ_IMFAIL ); +} + +=head2 $future = $f1->followed_by( \&code ) + +Returns a new sequencing C<Future> that runs the code regardless of success or +failure. Once C<$f1> is ready the code reference will be invoked and is passed +one argument, C<$f1>. It should return a future, C<$f2>. Once C<$f2> completes +the sequence future will then be marked as complete with whatever result +C<$f2> gave. + + $f2 = $code->( $f1 ) + +=cut + +sub followed_by +{ + my $self = shift; + my ( $code ) = @_; + + return $self->_sequence( $code, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); +} + +sub and_then +{ + Carp::croak "Future->and_then is now removed; use ->then_with_f instead"; +} + +sub or_else +{ + Carp::croak "Future->or_else is now removed; use ->else_with_f instead"; +} + +=head2 $future = $f1->without_cancel + +Returns a new sequencing C<Future> that will complete with the success or +failure of the original future, but if cancelled, will not cancel the +original. This may be useful if the original future represents an operation +that is being shared among multiple sequences; cancelling one should not +prevent the others from running too. + +=cut + +sub without_cancel +{ + my $self = shift; + my $new = $self->new; + + $self->on_ready( sub { + my $self = shift; + if( $self->failure ) { + $new->fail( $self->failure ); + } + else { + $new->done( $self->get ); + } + }); + + return $new; +} + +=head1 CONVERGENT FUTURES + +The following constructors all take a list of component futures, and return a +new future whose readiness somehow depends on the readiness of those +components. The first derived class component future will be used as the +prototype for constructing the return value, so it respects subclassing +correctly, or failing that a plain C<Future>. + +=cut + +sub _new_convergent +{ + shift; # ignore this class + my ( $subs ) = @_; + + foreach my $sub ( @$subs ) { + blessed $sub and $sub->isa( "Future" ) or Carp::croak "Expected a Future, got $_"; + } + + # Find the best prototype. Ideally anything derived if we can find one. + my $self; + ref($_) eq "Future" or $self = $_->new, last for @$subs; + + # No derived ones; just have to be a basic class then + $self ||= Future->new; + + $self->{subs} = $subs; + + # This might be called by a DESTROY during global destruction so it should + # be as defensive as possible (see RT88967) + $self->on_cancel( sub { + foreach my $sub ( @$subs ) { + $sub->cancel if $sub and !$sub->{ready}; + } + } ); + + return $self; +} + +=head2 $future = Future->wait_all( @subfutures ) + +Returns a new C<Future> instance that will indicate it is ready once all of +the sub future objects given to it indicate that they are ready, either by +success, failure or cancellation. Its result will a list of its component +futures. + +When given an empty list this constructor returns a new immediately-done +future. + +This constructor would primarily be used by users of asynchronous interfaces. + +=cut + +sub wait_all +{ + my $class = shift; + my @subs = @_; + + unless( @subs ) { + my $self = $class->done; + $self->{subs} = []; + return $self; + } + + my $self = Future->_new_convergent( \@subs ); + + my $pending = 0; + $_->{ready} or $pending++ for @subs; + + # Look for immediate ready + if( !$pending ) { + $self->{result} = [ @subs ]; + $self->_mark_ready( "wait_all" ); + return $self; + } + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + + $pending--; + $pending and return; + + $weakself->{result} = [ @subs ]; + $weakself->_mark_ready( "wait_all" ); + }; + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->on_ready( $sub_on_ready ); + } + + return $self; +} + +=head2 $future = Future->wait_any( @subfutures ) + +Returns a new C<Future> instance that will indicate it is ready once any of +the sub future objects given to it indicate that they are ready, either by +success or failure. Any remaining component futures that are not yet ready +will be cancelled. Its result will be the result of the first component future +that was ready; either success or failure. Any component futures that are +cancelled are ignored, apart from the final component left; at which point the +result will be a failure. + +When given an empty list this constructor returns an immediately-failed +future. + +This constructor would primarily be used by users of asynchronous interfaces. + +=cut + +sub wait_any +{ + my $class = shift; + my @subs = @_; + + unless( @subs ) { + my $self = $class->fail( "Cannot ->wait_any with no subfutures" ); + $self->{subs} = []; + return $self; + } + + my $self = Future->_new_convergent( \@subs ); + + # Look for immediate ready + my $immediate_ready; + foreach my $sub ( @subs ) { + $sub->{ready} and $immediate_ready = $sub, last; + } + + if( $immediate_ready ) { + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->cancel; + } + + if( $immediate_ready->{failure} ) { + $self->{failure} = [ $immediate_ready->failure ]; + } + else { + $self->{result} = [ $immediate_ready->get ]; + } + $self->_mark_ready( "wait_any" ); + return $self; + } + + my $pending = 0; + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel + + return if --$pending and $_[0]->{cancelled}; + + if( $_[0]->{cancelled} ) { + $weakself->{failure} = [ "All component futures were cancelled" ]; + } + elsif( $_[0]->{failure} ) { + $weakself->{failure} = [ $_[0]->failure ]; + } + else { + $weakself->{result} = [ $_[0]->get ]; + } + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->cancel; + } + + $weakself->_mark_ready( "wait_any" ); + }; + + foreach my $sub ( @subs ) { + # No need to test $sub->{ready} since we know none of them are + $sub->on_ready( $sub_on_ready ); + $pending++; + } + + return $self; +} + +=head2 $future = Future->needs_all( @subfutures ) + +Returns a new C<Future> instance that will indicate it is ready once all of the +sub future objects given to it indicate that they have completed successfully, +or when any of them indicates that they have failed. If any sub future fails, +then this will fail immediately, and the remaining subs not yet ready will be +cancelled. Any component futures that are cancelled will cause an immediate +failure of the result. + +If successful, its result will be a concatenated list of the results of all +its component futures, in corresponding order. If it fails, its failure will +be that of the first component future that failed. To access each component +future's results individually, use C<done_futures>. + +When given an empty list this constructor returns a new immediately-done +future. + +This constructor would primarily be used by users of asynchronous interfaces. + +=cut + +sub needs_all +{ + my $class = shift; + my @subs = @_; + + unless( @subs ) { + my $self = $class->done; + $self->{subs} = []; + return $self; + } + + my $self = Future->_new_convergent( \@subs ); + + # Look for immediate fail + my $immediate_fail; + foreach my $sub ( @subs ) { + $sub->{ready} and $sub->{failure} and $immediate_fail = $sub, last; + } + + if( $immediate_fail ) { + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->cancel; + } + + $self->{failure} = [ $immediate_fail->failure ]; + $self->_mark_ready( "needs_all" ); + return $self; + } + + my $pending = 0; + $_->{ready} or $pending++ for @subs; + + # Look for immediate done + if( !$pending ) { + $self->{result} = [ map { $_->get } @subs ]; + $self->_mark_ready( "needs_all" ); + return $self; + } + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel + + if( $_[0]->{cancelled} ) { + $weakself->{failure} = [ "A component future was cancelled" ]; + foreach my $sub ( @subs ) { + $sub->cancel if !$sub->{ready}; + } + $weakself->_mark_ready( "needs_all" ); + } + elsif( my @failure = $_[0]->failure ) { + $weakself->{failure} = \@failure; + foreach my $sub ( @subs ) { + $sub->cancel if !$sub->{ready}; + } + $weakself->_mark_ready( "needs_all" ); + } + else { + $pending--; + $pending and return; + + $weakself->{result} = [ map { $_->get } @subs ]; + $weakself->_mark_ready( "needs_all" ); + } + }; + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->on_ready( $sub_on_ready ); + } + + return $self; +} + +=head2 $future = Future->needs_any( @subfutures ) + +Returns a new C<Future> instance that will indicate it is ready once any of +the sub future objects given to it indicate that they have completed +successfully, or when all of them indicate that they have failed. If any sub +future succeeds, then this will succeed immediately, and the remaining subs +not yet ready will be cancelled. Any component futures that are cancelled are +ignored, apart from the final component left; at which point the result will +be a failure. + +If successful, its result will be that of the first component future that +succeeded. If it fails, its failure will be that of the last component future +to fail. To access the other failures, use C<failed_futures>. + +Normally when this future completes successfully, only one of its component +futures will be done. If it is constructed with multiple that are already done +however, then all of these will be returned from C<done_futures>. Users should +be careful to still check all the results from C<done_futures> in that case. + +When given an empty list this constructor returns an immediately-failed +future. + +This constructor would primarily be used by users of asynchronous interfaces. + +=cut + +sub needs_any +{ + my $class = shift; + my @subs = @_; + + unless( @subs ) { + my $self = $class->fail( "Cannot ->needs_any with no subfutures" ); + $self->{subs} = []; + return $self; + } + + my $self = Future->_new_convergent( \@subs ); + + # Look for immediate done + my $immediate_done; + my $pending = 0; + foreach my $sub ( @subs ) { + $sub->{ready} and !$sub->{failure} and $immediate_done = $sub, last; + $sub->{ready} or $pending++; + } + + if( $immediate_done ) { + foreach my $sub ( @subs ) { + $sub->{ready} ? $sub->{reported} = 1 : $sub->cancel; + } + + $self->{result} = [ $immediate_done->get ]; + $self->_mark_ready( "needs_any" ); + return $self; + } + + # Look for immediate fail + my $immediate_fail = 1; + foreach my $sub ( @subs ) { + $sub->{ready} or $immediate_fail = 0, last; + } + + if( $immediate_fail ) { + $_->{reported} = 1 for @subs; + # For consistency we'll pick the last one for the failure + $self->{failure} = [ $subs[-1]->{failure} ]; + $self->_mark_ready( "needs_any" ); + return $self; + } + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel + + return if --$pending and $_[0]->{cancelled}; + + if( $_[0]->{cancelled} ) { + $weakself->{failure} = [ "All component futures were cancelled" ]; + $weakself->_mark_ready( "needs_any" ); + } + elsif( my @failure = $_[0]->failure ) { + $pending and return; + + $weakself->{failure} = \@failure; + $weakself->_mark_ready( "needs_any" ); + } + else { + $weakself->{result} = [ $_[0]->get ]; + foreach my $sub ( @subs ) { + $sub->cancel if !$sub->{ready}; + } + $weakself->_mark_ready( "needs_any" ); + } + }; + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->on_ready( $sub_on_ready ); + } + + return $self; +} + +=head1 METHODS ON CONVERGENT FUTURES + +The following methods apply to convergent (i.e. non-leaf) futures, to access +the component futures stored by it. + +=cut + +=head2 @f = $future->pending_futures + +=head2 @f = $future->ready_futures + +=head2 @f = $future->done_futures + +=head2 @f = $future->failed_futures + +=head2 @f = $future->cancelled_futures + +Return a list of all the pending, ready, done, failed, or cancelled +component futures. In scalar context, each will yield the number of such +component futures. + +=cut + +sub pending_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->pending_futures on a non-convergent Future"; + return grep { not $_->{ready} } @{ $self->{subs} }; +} + +sub ready_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->ready_futures on a non-convergent Future"; + return grep { $_->{ready} } @{ $self->{subs} }; +} + +sub done_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->done_futures on a non-convergent Future"; + return grep { $_->{ready} and not $_->{failure} and not $_->{cancelled} } @{ $self->{subs} }; +} + +sub failed_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->failed_futures on a non-convergent Future"; + return grep { $_->{ready} and $_->{failure} } @{ $self->{subs} }; +} + +sub cancelled_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->cancelled_futures on a non-convergent Future"; + return grep { $_->{ready} and $_->{cancelled} } @{ $self->{subs} }; +} + +=head1 TRACING METHODS + +=head2 $future = $future->set_label( $label ) + +=head2 $label = $future->label + +Chaining mutator and accessor for the label of the C<Future>. This should be a +plain string value, whose value will be stored by the future instance for use +in debugging messages or other tooling, or similar purposes. + +=cut + +sub set_label +{ + my $self = shift; + ( $self->{label} ) = @_; + return $self; +} + +sub label +{ + my $self = shift; + return $self->{label}; +} + +sub __selfstr +{ + my $self = shift; + return "$self" unless defined $self->{label}; + return "$self (\"$self->{label}\")"; +} + +=head2 [ $sec, $usec ] = $future->btime + +=head2 [ $sec, $usec ] = $future->rtime + +Accessors that return the tracing timestamps from the instance. These give the +time the instance was contructed ("birth" time, C<btime>) and the time the +result was determined (the "ready" time, C<rtime>). Each result is returned as +a two-element ARRAY ref, containing the epoch time in seconds and +microseconds, as given by C<Time::HiRes::gettimeofday>. + +In order for these times to be captured, they have to be enabled by setting +C<$Future::TIMES> to a true value. This is initialised true at the time the +module is loaded if either C<PERL_FUTURE_DEBUG> or C<PERL_FUTURE_TIMES> are +set in the environment. + +=cut + +sub btime +{ + my $self = shift; + return $self->{btime}; +} + +sub rtime +{ + my $self = shift; + return $self->{rtime}; +} + +=head2 $sec = $future->elapsed + +If both tracing timestamps are defined, returns the number of seconds of +elapsed time between them as a floating-point number. If not, returns +C<undef>. + +=cut + +sub elapsed +{ + my $self = shift; + return undef unless defined $self->{btime} and defined $self->{rtime}; + return $self->{elapsed} ||= tv_interval( $self->{btime}, $self->{rtime} ); +} + +=head2 $cb = $future->wrap_cb( $operation_name, $cb ) + +I<Since version 0.31.> + +I<Note: This method is experimental and may be changed or removed in a later +version.> + +This method is invoked internally by various methods that are about to save a +callback CODE reference supplied by the user, to be invoked later. The default +implementation simply returns the callback agument as-is; the method is +provided to allow users to provide extra behaviour. This can be done by +applying a method modifier of the C<around> kind, so in effect add a chain of +wrappers. Each wrapper can then perform its own wrapping logic of the +callback. C<$operation_name> is a string giving the reason for which the +callback is being saved; currently one of C<on_ready>, C<on_done>, C<on_fail> +or C<sequence>; the latter being used for all the sequence-returning methods. + +This method is intentionally invoked only for CODE references that are being +saved on a pending C<Future> instance to be invoked at some later point. It +does not run for callbacks to be invoked on an already-complete instance. This +is for performance reasons, where the intended behaviour is that the wrapper +can provide some amount of context save and restore, to return the operating +environment for the callback back to what it was at the time it was saved. + +For example, the following wrapper saves the value of a package variable at +the time the callback was saved, and restores that value at invocation time +later on. This could be useful for preserving context during logging in a +Future-based program. + + our $LOGGING_CTX; + + no warnings 'redefine'; + + my $orig = Future->can( "wrap_cb" ); + *Future::wrap_cb = sub { + my $cb = $orig->( @_ ); + + my $saved_logging_ctx = $LOGGING_CTX; + + return sub { + local $LOGGING_CTX = $saved_logging_ctx; + $cb->( @_ ); + }; + }; + +At this point, any code deferred into a C<Future> by any of its callbacks will +observe the C<$LOGGING_CTX> variable as having the value it held at the time +the callback was saved, even if it is invoked later on when that value is +different. + +Remember when writing such a wrapper, that it still needs to invoke the +previous version of the method, so that it plays nicely in combination with +others (see the C<< $orig->( @_ ) >> part). + +=cut + +sub wrap_cb +{ + my $self = shift; + my ( $op, $cb ) = @_; + return $cb; +} + +=head1 EXAMPLES + +The following examples all demonstrate possible uses of a C<Future> +object to provide a fictional asynchronous API. + +For more examples, comparing the use of C<Future> with regular call/return +style Perl code, see also L<Future::Phrasebook>. + +=head2 Providing Results + +By returning a new C<Future> object each time the asynchronous function is +called, it provides a placeholder for its eventual result, and a way to +indicate when it is complete. + + sub foperation + { + my %args = @_; + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => sub { $future->done( @_ ); }, + ); + + return $future; + } + +In most cases, the C<done> method will simply be invoked with the entire +result list as its arguments. In that case, it is simpler to use the +C<done_cb> wrapper method to create the C<CODE> reference. + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => $future->done_cb, + ); + +The caller may then use this future to wait for a result using the C<on_ready> +method, and obtain the result using C<get>. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + say "The operation returned: ", $f->get; + } ); + +=head2 Indicating Success or Failure + +Because the stored exception value of a failed future may not be false, the +C<failure> method can be used in a conditional statement to detect success or +failure. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + if( not my $e = $f->failure ) { + say "The operation succeeded with: ", $f->get; + } + else { + say "The operation failed with: ", $e; + } + } ); + +By using C<not> in the condition, the order of the C<if> blocks can be +arranged to put the successful case first, similar to a C<try>/C<catch> block. + +Because the C<get> method re-raises the passed exception if the future failed, +it can be used to control a C<try>/C<catch> block directly. (This is sometimes +called I<Exception Hoisting>). + + use Try::Tiny; + + $f->on_ready( sub { + my $f = shift; + try { + say "The operation succeeded with: ", $f->get; + } + catch { + say "The operation failed with: ", $_; + }; + } ); + +Even neater still may be the separate use of the C<on_done> and C<on_fail> +methods. + + $f->on_done( sub { + my @result = @_; + say "The operation succeeded with: ", @result; + } ); + $f->on_fail( sub { + my ( $failure ) = @_; + say "The operation failed with: $failure"; + } ); + +=head2 Immediate Futures + +Because the C<done> method returns the future object itself, it can be used to +generate a C<Future> that is immediately ready with a result. This can also be +used as a class method. + + my $f = Future->done( $value ); + +Similarly, the C<fail> and C<die> methods can be used to generate a C<Future> +that is immediately failed. + + my $f = Future->die( "This is never going to work" ); + +This could be considered similarly to a C<die> call. + +An C<eval{}> block can be used to turn a C<Future>-returning function that +might throw an exception, into a C<Future> that would indicate this failure. + + my $f = eval { function() } || Future->fail( $@ ); + +This is neater handled by the C<call> class method, which wraps the call in +an C<eval{}> block and tests the result: + + my $f = Future->call( \&function ); + +=head2 Sequencing + +The C<then> method can be used to create simple chains of dependent tasks, +each one executing and returning a C<Future> when the previous operation +succeeds. + + my $f = do_first() + ->then( sub { + return do_second(); + }) + ->then( sub { + return do_third(); + }); + +The result of the C<$f> future itself will be the result of the future +returned by the final function, if none of them failed. If any of them fails +it will fail with the same failure. This can be considered similar to normal +exception handling in synchronous code; the first time a function call throws +an exception, the subsequent calls are not made. + +=head2 Merging Control Flow + +A C<wait_all> future may be used to resynchronise control flow, while waiting +for multiple concurrent operations to finish. + + my $f1 = foperation( foo => "something" ); + my $f2 = foperation( bar => "something else" ); + + my $f = Future->wait_all( $f1, $f2 ); + + $f->on_ready( sub { + say "Operations are ready:"; + say " foo: ", $f1->get; + say " bar: ", $f2->get; + } ); + +This provides an ability somewhat similar to C<CPS::kpar()> or +L<Async::MergePoint>. + +=cut + +=head1 KNOWN ISSUES + +=head2 Cancellation of Non-Final Sequence Futures + +The behaviour of future cancellation still has some unanswered questions +regarding how to handle the situation where a future is cancelled that has a +sequence future constructed from it. + +In particular, it is unclear in each of the following examples what the +behaviour of C<$f2> should be, were C<$f1> to be cancelled: + + $f2 = $f1->then( sub { ... } ); # plus related ->then_with_f, ... + + $f2 = $f1->else( sub { ... } ); # plus related ->else_with_f, ... + + $f2 = $f1->followed_by( sub { ... } ); + +In the C<then>-style case it is likely that this situation should be treated +as if C<$f1> had failed, perhaps with some special message. The C<else>-style +case is more complex, because it may be that the entire operation should still +fail, or it may be that the cancellation of C<$f1> should again be treated +simply as a special kind of failure, and the C<else> logic run as normal. + +To be specific; in each case it is unclear what happens if the first future is +cancelled, while the second one is still waiting on it. The semantics for +"normal" top-down cancellation of C<$f2> and how it affects C<$f1> are already +clear and defined. + +=head2 Cancellation of Divergent Flow + +A further complication of cancellation comes from the case where a given +future is reused multiple times for multiple sequences or convergent trees. + +In particular, it is in clear in each of the following examples what the +behaviour of C<$f2> should be, were C<$f1> to be cancelled: + + my $f_initial = Future->new; ... + my $f1 = $f_initial->then( ... ); + my $f2 = $f_initial->then( ... ); + + my $f1 = Future->needs_all( $f_initial ); + my $f2 = Future->needs_all( $f_initial ); + +The point of cancellation propagation is to trace backwards through stages of +some larger sequence of operations that now no longer need to happen, because +the final result is no longer required. But in each of these cases, just +because C<$f1> has been cancelled, the initial future C<$f_initial> is still +required because there is another future (C<$f2>) that will still require its +result. + +Initially it would appear that some kind of reference-counting mechanism could +solve this question, though that itself is further complicated by the +C<on_ready> handler and its variants. + +It may simply be that a comprehensive useful set of cancellation semantics +can't be universally provided to cover all cases; and that some use-cases at +least would require the application logic to give extra information to its +C<Future> objects on how they should wire up the cancel propagation logic. + +Both of these cancellation issues are still under active design consideration; +see the discussion on RT96685 for more information +(L<https://rt.cpan.org/Ticket/Display.html?id=96685>). + +=cut + +=head1 SEE ALSO + +=over 4 + +=item * + +L<curry> - Create automatic curried method call closures for any class or +object + +=item * + +"The Past, The Present and The Future" - slides from a talk given at the +London Perl Workshop, 2012. + +L<https://docs.google.com/presentation/d/1UkV5oLcTOOXBXPh8foyxko4PR28_zU_aVx6gBms7uoo/edit> + +=item * + +"Futures advent calendar 2013" + +L<http://leonerds-code.blogspot.co.uk/2013/12/futures-advent-day-1.html> + +=back + +=cut + +=head1 TODO + +=over 4 + +=item * + +Consider the ability to pass the constructor an C<await> CODEref, instead of +needing to use a subclass. This might simplify async/etc.. implementations, +and allows the reuse of the idea of subclassing to extend the abilities of +C<Future> itself - for example to allow a kind of Future that can report +incremental progress. + +=back + +=cut + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut + +0x55AA; diff --git a/lib/Future/Phrasebook.pod b/lib/Future/Phrasebook.pod new file mode 100644 index 0000000..2798536 --- /dev/null +++ b/lib/Future/Phrasebook.pod @@ -0,0 +1,500 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk + +=head1 NAME + +C<Future::Phrasebook> - coding examples for C<Future> and C<Future::Utils> + +This documentation-only module provides a phrasebook-like approach to giving +examples on how to use L<Future> and L<Future::Utils> to structure +Future-driven asynchronous or concurrent logic. As with any inter-dialect +phrasebook it is structured into pairs of examples; each given first in a +traditional call/return Perl style, and second in a style using Futures. In +each case, the generic function or functions in the example are named in +C<ALL_CAPITALS()> to make them stand out. + +In the examples showing use of Futures, any function that is expected to +return a C<Future> instance is named with a leading C<F_> prefix. Each example +is also constructed so as to yield an overall future in a variable called +C<$f>, which represents the entire operation. + +=head1 SEQUENCING + +The simplest example of a sequencing operation is simply running one piece of +code, then immediately running a second. In call/return code we can just place +one after the other. + + FIRST(); + SECOND(); + +Using a Future it is necessary to await the result of the first C<Future> +before calling the second. + + my $f = F_FIRST() + ->then( sub { F_SECOND(); } ); + +Here, the anonymous closure is invoked once the C<Future> returned by +C<F_FIRST()> succeeds. Because C<then> invokes the code block only if the +first Future succeeds, it shortcircuits around failures similar to the way that +C<die()> shortcircuits around thrown exceptions. A C<Future> representing the +entire combination is returned by the method. + +Because the C<then> method itself returns a C<Future> representing the +overall operation, it can itself be further chained. + + FIRST(); + SECOND(); + THIRD(); + +Z<> + + my $f = F_FIRST() + ->then( sub { F_SECOND(); } ) + ->then( sub { F_THIRD(); } ); + +See below for examples of ways to handle exceptions. + +=head2 Passing Results + +Often the result of one function can be passed as an argument to another +function. + + OUTER( INNER() ); + +The result of the first C<Future> is passed into the code block given to the +C<then> method. + + my $f = F_INNER() + ->then( sub { F_OUTER( @_ ) } ); + +=head1 CONDITIONALS + +It may be that the result of one function call is used to determine whether or +not another operation is taken. + + if( COND() == $value ) { + ACTION(); + } + +Because the C<then_with_f> code block is given the first future in addition to +its results it can decide whether to call the second function to return a new +future, or simply return the one it was given. + + my $f = F_COND() + ->then_with_f( sub { + my ( $f_cond, $result ) = @_; + if( $result == $value ) { + return F_ACTION(); + } + else { + return $f_cond; + } + }); + +=head1 EXCEPTION HANDLING + +In regular call/return style code, if any function throws an exception, the +remainder of the block is not executed, the containing C<try> or C<eval> is +aborted, and control is passed to the corresponding C<catch> or line after the +C<eval>. + + try { + FIRST(); + } + catch { + my $e = $_; + ERROR( $e ); + }; + +The C<else> method on a C<Future> can be used here. It behaves similar to +C<then>, but is only invoked if the initial C<Future> fails; not if it +succeeds. + + my $f = F_FIRST() + ->else( sub { F_ERROR( @_ ); } ); + +Alternatively, the second argument to the C<then> method can be applied, which +is invoked only on case of failure. + + my $f = F_FIRST() + ->then( undef, sub { F_ERROR( @_ ); } ); + +Often it may be the case that the failure-handling code is in fact immediate, +and doesn't return a C<Future>. In that case, the C<else> code block can +return an immediate C<Future> instance. + + my $f = F_FIRST() + ->else( sub { + ERROR( @_ ); + return Future->done; + }); + +Sometimes the failure handling code simply needs to be aware of the failure, +but rethrow it further up. + + try { + FIRST(); + } + catch { + my $e = $_; + ERROR( $e ); + die $e; + }; + +In this case, while the C<else> block could return a new C<Future> failed with +the same exception, the C<else_with_f> block is passed the failed C<Future> +itself in addition to the failure details so it can just return that. + + my $f = F_FIRST() + ->else_with_f( sub { + my ( $f1, @failure ) = @_; + ERROR( @failure ); + return $f1; + }); + +The C<followed_by> method is similar again, though it invokes the code block +regardless of the success or failure of the initial C<Future>. It can be used +to create C<finally> semantics. By returning the C<Future> instance that it +was passed, the C<followed_by> code ensures it doesn't affect the result of +the operation. + + try { + FIRST(); + } + catch { + ERROR( $_ ); + } + finally { + CLEANUP(); + }; + +Z<> + + my $f = F_FIRST() + ->else( sub { + ERROR( @_ ); + return Future->done; + }) + ->followed_by( sub { + CLEANUP(); + return shift; + }); + +=head1 ITERATION + +To repeat a single block of code multiple times, a C<while> block is often +used. + + while( COND() ) { + FUNC(); + } + +The C<Future::Utils::repeat> function can be used to repeatedly iterate a +given C<Future>-returning block of code until its ending condition is +satisfied. + + use Future::Utils qw( repeat ); + my $f = repeat { + F_FUNC(); + } while => sub { COND() }; + +Unlike the statement nature of perl's C<while> block, this C<repeat> C<Future> +can yield a value; the value returned by C<< $f->get >> is the result of the +final trial of the code block. + +Here, the condition function it expected to return its result immediately. If +the repeat condition function itself returns a C<Future>, it can be combined +along with the loop body. The trial C<Future> returned by the code block is +passed to the C<while> condition function. + + my $f = repeat { + F_FUNC() + ->followed_by( sub { F_COND(); } ); + } while => sub { shift->get }; + +The condition can be negated by using C<until> instead + + until( HALTING_COND() ) { + FUNC(); + } + +Z<> + + my $f = repeat { + F_FUNC(); + } until => sub { HALTING_COND() }; + +=head2 Iterating with Exceptions + +Technically, this loop isn't quite the same as the equivalent C<while> loop in +plain Perl, because the C<while> loop will also stop executing if the code +within it throws an exception. This can be handled in C<repeat> by testing for +a failed C<Future> in the C<until> condition. + + while(1) { + TRIAL(); + } + +Z<> + + my $f = repeat { + F_TRIAL(); + } until => sub { shift->failure }; + +When a repeat loop is required to retry a failure, the C<try_repeat> function +should be used. Currently this function behaves equivalently to C<repeat>, +except that it will not print a warning if it is asked to retry after a +failure, whereas this behaviour is now deprecated for the regular C<repeat> +function so that yields a warning. + + my $f = try_repeat { + F_TRIAL(); + } while => sub { shift->failure }; + +Another variation is the C<try_repeat_until_success> function, which provides +a convenient shortcut to calling C<try_repeat> with a condition that makes +another attempt each time the previous one fails; stopping once it achieves a +successful result. + + while(1) { + eval { TRIAL(); 1 } and last; + } + +Z<> + + my $f = try_repeat_until_success { + F_TRIAL(); + }; + +=head2 Iterating over a List + +A variation on the idea of the C<while> loop is the C<foreach> loop; a loop +that executes once for each item in a given list, with a variable set to one +value from that list each time. + + foreach my $thing ( @THINGS ) { + INSPECT( $thing ); + } + +This can be performed with C<Future> using the C<foreach> parameter to the +C<repeat> function. When this is in effect, the block of code is passed each +item of the given list as the first parameter. + + my $f = repeat { + my $thing = shift; + F_INSPECT( $thing ); + } foreach => \@THINGS; + +=head2 Recursing over a Tree + +A regular call/return function can use recursion to walk over a tree-shaped +structure, where each item yields a list of child items. + + sub WALK + { + my ( $item ) = @_; + ... + WALK($_) foreach CHILDREN($item); + } + +This recursive structure can be turned into a C<while()>-based repeat loop by +using an array to store the remaining items to walk into, instead of using the +perl stack directly: + + sub WALK + { + my @more = ( $root ); + while( @more ) { + my $item = shift @more; + ... + unshift @more, CHILDREN($item) + } + } + +This arrangement then allows us to use C<fmap_void> to walk this structure +using Futures, possibly concurrently. A lexical array variable is captured +that holds the stack of remaining items, which is captured by the item code so +it can C<unshift> more into it, while also being used as the actual C<fmap> +control array. + + my @more = ( $root ); + + my $f = fmap_void { + my $item = shift; + ...->on_done( sub { + unshift @more, @CHILDREN; + }) + } foreach => \@more; + +By choosing to either C<unshift> or C<push> more items onto this list, the +tree can be walked in either depth-first or breadth-first order. + +=head1 SHORT-CIRCUITING + +Sometimes a result is determined that should be returned through several +levels of control structure. Regular Perl code has such keywords as C<return> +to return a value from a function immediately, or C<last> for immediately +stopping execution of a loop. + + sub func { + foreach my $item ( @LIST ) { + if( COND($item) ) { + return $item; + } + } + return MAKE_NEW_ITEM(); + } + +The C<Future::Utils::call_with_escape> function allows this general form of +control flow, by calling a block of code that is expected to return a future, +and itself returning a future. Under normal circumstances the result of this +future propagates through to the one returned by C<call_with_escape>. + +However, the code is also passed in a future value, called here the "escape +future". If the code captures this future and completes it (either by calling +C<done> or C<fail>), then the overall returned future immediately completes +with that result instead, and the future returned by the code block is +cancelled. + + my $f = call_with_escape { + my $escape_f = shift; + + ( repeat { + my $item = shift; + COND($item)->then( sub { + my ( $result ) = @_; + if( $result ) { + $escape_f->done( $item ); + } + return Future->done; + }) + } foreach => \@ITEMS )->then( sub { + MAKE_NEW_ITEM(); + }); + }; + +Here, if C<$escape_f> is completed by the condition test, the future chain +returned by the code (that is, the C<then> chain of the C<repeat> block +followed by C<MAKE_NEW_ITEM()>) will be cancelled, and C<$f> itself will +receive this result. + +=head1 CONCURRENCY + +This final section of the phrasebook demonstrates a number of abilities that +are simple to do with C<Future> but can't easily be done with regular +call/return style programming, because they all involve an element of +concurrency. In these examples the comparison with regular call/return code +will be somewhat less accurate because of the inherent ability for the +C<Future>-using version to behave concurrently. + +=head2 Waiting on Multiple Functions + +The C<< Future->wait_all >> constructor creates a C<Future> that waits for all +of the component futures to complete. This can be used to form a sequence with +concurrency. + + { FIRST_A(); FIRST_B() } + SECOND(); + +Z<> + + my $f = Future->wait_all( FIRST_A(), FIRST_B() ) + ->then( sub { SECOND() } ); + +Unlike in the call/return case, this can perform the work of C<FIRST_A()> and +C<FIRST_B()> concurrently, only proceeding to C<SECOND()> when both are ready. + +The result of the C<wait_all> C<Future> is the list of its component +C<Future>s. This can be used to obtain the results. + + SECOND( FIRST_A(), FIRST_B() ); + +Z<> + + my $f = Future->wait_all( FIRST_A(), FIRST_B() ) + ->then( sub { + my ( $f_a, $f_b ) = @_ + SECOND( $f_a->get, $f_b->get ); + } ); + +Because the C<get> method will re-raise an exception caused by a failure of +either of the C<FIRST> functions, the second stage will fail if any of the +initial Futures failed. + +As this is likely to be the desired behaviour most of the time, this kind of +control flow can be written slightly neater using C<< Future->needs_all >> +instead. + + my $f = Future->needs_all( FIRST_A(), FIRST_B() ) + ->then( sub { SECOND( @_ ) } ); + +The C<get> method of a C<needs_all> convergent Future returns a concatenated +list of the results of all its component Futures, as the only way it will +succeed is if all the components do. + +=head2 Waiting on Multiple Calls of One Function + +Because the C<wait_all> and C<needs_all> constructors take an entire list of +C<Future> instances, they can be conveniently used with C<map> to wait on the +result of calling a function concurrently once per item in a list. + + my @RESULT = map { FUNC( $_ ) } @ITEMS; + PROCESS( @RESULT ); + +Again, the C<needs_all> version allows more convenient access to the list of +results. + + my $f = Future->needs_all( map { F_FUNC( $_ ) } @ITEMS ) + ->then( sub { + my @RESULT = @_; + F_PROCESS( @RESULT ) + } ); + +This form of the code starts every item's future concurrently, then waits for +all of them. If the list of C<@ITEMS> is potentially large, this may cause a +problem due to too many items running at once. Instead, the +C<Future::Utils::fmap> family of functions can be used to bound the +concurrency, keeping at most some given number of items running, starting new +ones as existing ones complete. + + my $f = fmap { + my $item = shift; + F_FUNC( $item ) + } foreach => \@ITEMS; + +By itself, this will not actually act concurrently as it will only keep one +Future outstanding at a time. The C<concurrent> flag lets it keep a larger +number "in flight" at any one time: + + my $f = fmap { + my $item = shift; + F_FUNC( $item ) + } foreach => \@ITEMS, concurrent => 10; + +The C<fmap> and C<fmap_scalar> functions return a Future that will eventually +give the collected results of the individual item futures, thus making them +similar to perl's C<map> operator. + +Sometimes, no result is required, and the items are run in a loop simply for +some side-effect of the body. + + foreach my $item ( @ITEMS ) { + FUNC( $item ); + } + +To avoid having to collect a potentially-large set of results only to throw +them away, the C<fmap_void> function variant of the C<fmap> family yields a +Future that completes with no result after all the items are complete. + + my $f = fmap_void { + my $item = shift; + F_FIRST( $item ) + } foreach => \@ITEMS, concurrent => 10; + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut diff --git a/lib/Future/Utils.pm b/lib/Future/Utils.pm new file mode 100644 index 0000000..563f327 --- /dev/null +++ b/lib/Future/Utils.pm @@ -0,0 +1,687 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2013-2015 -- leonerd@leonerd.org.uk + +package Future::Utils; + +use strict; +use warnings; + +our $VERSION = '0.32'; + +use Exporter 'import'; +# Can't import the one from Exporter as it relies on package inheritance +sub export_to_level +{ + my $pkg = shift; local $Exporter::ExportLevel = 1 + shift; $pkg->import(@_); +} + +our @EXPORT_OK = qw( + call + call_with_escape + + repeat + try_repeat try_repeat_until_success + repeat_until_success + + fmap fmap_concat + fmap1 fmap_scalar + fmap0 fmap_void +); + +use Carp; +our @CARP_NOT = qw( Future ); + +use Future; + +=head1 NAME + +C<Future::Utils> - utility functions for working with C<Future> objects + +=head1 SYNOPSIS + + use Future::Utils qw( call_with_escape ); + + my $result_f = call_with_escape { + my $escape_f = shift; + my $f = ... + $escape_f->done( "immediate result" ); + ... + }; + +Z<> + + use Future::Utils qw( repeat try_repeat try_repeat_until_success ); + + my $eventual_f = repeat { + my $trial_f = ... + return $trial_f; + } while => sub { my $f = shift; return want_more($f) }; + + my $eventual_f = repeat { + ... + return $trail_f; + } until => sub { my $f = shift; return acceptable($f) }; + + my $eventual_f = repeat { + my $item = shift; + ... + return $trial_f; + } foreach => \@items; + + my $eventual_f = try_repeat { + my $trial_f = ... + return $trial_f; + } while => sub { ... }; + + my $eventual_f = try_repeat_until_success { + ... + return $trial_f; + }; + + my $eventual_f = try_repeat_until_success { + my $item = shift; + ... + return $trial_f; + } foreach => \@items; + +Z<> + + use Future::Utils qw( fmap_concat fmap_scalar fmap_void ); + + my $result_f = fmap_concat { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 4; + + my $result_f = fmap_scalar { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 8; + + my $done_f = fmap_void { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 10; + +=cut + +=head1 INVOKING A BLOCK OF CODE + +=head2 $f = call { CODE } + +The C<call> function invokes a block of code that returns a future, and simply +returns the future it returned. The code is wrapped in an C<eval {}> block, so +that if it throws an exception this is turned into an immediate failed +C<Future>. If the code does not return a C<Future>, then an immediate failed +C<Future> instead. + +(This is equivalent to using C<< Future->call >>, but is duplicated here for +completeness). + +=cut + +sub call(&) +{ + my ( $code ) = @_; + return Future->call( $code ); +} + +=head2 $f = call_with_escape { CODE } + +The C<call_with_escape> function invokes a block of code that returns a +future, and passes in a separate future (called here an "escape future"). +Normally this is equivalent to the simple C<call> function. However, if the +code captures this future and completes it by calling C<done> or C<fail> on +it, the future returned by C<call_with_escape> immediately completes with this +result, and the future returned by the code itself is cancelled. + +This can be used to implement short-circuit return from an iterating loop or +complex sequence of code, or immediate fail that bypasses failure handling +logic in the code itself, or several other code patterns. + + $f = $code->( $escape_f ) + +(This can be considered similar to C<call-with-escape-continuation> as found +in some Scheme implementations). + +=cut + +sub call_with_escape(&) +{ + my ( $code ) = @_; + + my $escape_f = Future->new; + + return Future->wait_any( + Future->call( $code, $escape_f ), + $escape_f, + ); +} + +=head1 REPEATING A BLOCK OF CODE + +The C<repeat> function provides a way to repeatedly call a block of code that +returns a L<Future> (called here a "trial future") until some ending condition +is satisfied. The C<repeat> function itself returns a C<Future> to represent +running the repeating loop until that end condition (called here the "eventual +future"). The first time the code block is called, it is passed no arguments, +and each subsequent invocation is passed the previous trial future. + +The result of the eventual future is the result of the last trial future. + +If the eventual future is cancelled, the latest trial future will be +cancelled. + +If some specific subclass or instance of C<Future> is required as the return +value, it can be passed as the C<return> argument. Otherwise the return value +will be constructed by cloning the first non-immediate trial C<Future>. + +=head2 $future = repeat { CODE } while => CODE + +Repeatedly calls the C<CODE> block while the C<while> condition returns a true +value. Each time the trial future completes, the C<while> condition is passed +the trial future. + + $trial_f = $code->( $previous_trial_f ) + $again = $while->( $trial_f ) + +If the C<$code> block dies entirely and throws an exception, this will be +caught and considered as an immediately-failed C<Future> with the exception as +the future's failure. The exception will not be propagated to the caller. + +=head2 $future = repeat { CODE } until => CODE + +Repeatedly calls the C<CODE> block until the C<until> condition returns a true +value. Each time the trial future completes, the C<until> condition is passed +the trial future. + + $trial_f = $code->( $previous_trial_f ) + $accept = $until->( $trial_f ) + +=head2 $future = repeat { CODE } foreach => ARRAY, otherwise => CODE + +Calls the C<CODE> block once for each value obtained from the array, passing +in the value as the first argument (before the previous trial future). When +there are no more items left in the array, the C<otherwise> code is invoked +once and passed the last trial future, if there was one, or C<undef> if the +list was originally empty. The result of the eventual future will be the +result of the future returned from C<otherwise>. + +The referenced array may be modified by this operation. + + $trial_f = $code->( $item, $previous_trial_f ) + $final_f = $otherwise->( $last_trial_f ) + +The C<otherwise> code is optional; if not supplied then the result of the +eventual future will simply be that of the last trial. If there was no trial, +because the C<foreach> list was already empty, then an immediate successful +future with an empty result is returned. + +=head2 $future = repeat { CODE } foreach => ARRAY, while => CODE, ... + +=head2 $future = repeat { CODE } foreach => ARRAY, until => CODE, ... + +Combines the effects of C<foreach> with C<while> or C<until>. Calls the +C<CODE> block once for each value obtained from the array, until the array is +exhausted or the given ending condition is satisfied. + +If a C<while> or C<until> condition is combined with C<otherwise>, the +C<otherwise> code will only be run if the array was entirely exhausted. If the +operation is terminated early due to the C<while> or C<until> condition being +satisfied, the eventual result will simply be that of the last trial that was +executed. + +=head2 $future = repeat { CODE } generate => CODE, otherwise => CODE + +Calls the C<CODE> block once for each value obtained from the generator code, +passing in the value as the first argument (before the previous trial future). +When the generator returns an empty list, the C<otherwise> code is invoked and +passed the last trial future, if there was one, otherwise C<undef> if the +generator never returned a value. The result of the eventual future will be +the result of the future returned from C<otherwise>. + + $trial_f = $code->( $item, $previous_trial_f ) + $final_f = $otherwise->( $last_trial_f ) + + ( $item ) = $generate->() + +The generator is called in list context but should return only one item per +call. Subsequent values will be ignored. When it has no more items to return +it should return an empty list. + +For backward compatibility this function will allow a C<while> or C<until> +condition that requests a failure be repeated, but it will print a warning if +it has to do that. To apply repeating behaviour that can catch and retry +failures, use C<try_repeat> instead. This old behaviour is now deprecated and +will be removed in the next version. + +=cut + +sub _repeat +{ + my ( $code, $return, $trialp, $cond, $sense, $is_try ) = @_; + + my $prev = $$trialp; + + while(1) { + my $trial = $$trialp ||= Future->call( $code, $prev ); + $prev = $trial; + + if( !$trial->is_ready ) { + # defer + $return ||= $trial->new; + $trial->on_ready( sub { + return if $$trialp->is_cancelled; + _repeat( $code, $return, $trialp, $cond, $sense, $is_try ); + }); + return $return; + } + + my $stop; + if( not eval { $stop = !$cond->( $trial ) ^ $sense; 1 } ) { + $return ||= $trial->new; + $return->fail( $@ ); + return $return; + } + + if( $stop ) { + # Return result + $return ||= $trial->new; + $trial->on_done( $return ); + $trial->on_fail( $return ); + return $return; + } + + if( !$is_try and $trial->failure ) { + carp "Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead"; + } + + # redo + undef $$trialp; + } +} + +sub repeat(&@) +{ + my $code = shift; + my %args = @_; + + # This makes it easier to account for other conditions + defined($args{while}) + defined($args{until}) == 1 + or defined($args{foreach}) + or defined($args{generate}) + or croak "Expected one of 'while', 'until', 'foreach' or 'generate'"; + + if( $args{foreach} ) { + $args{generate} and croak "Cannot use both 'foreach' and 'generate'"; + + my $array = delete $args{foreach}; + $args{generate} = sub { + @$array ? shift @$array : (); + }; + } + + if( $args{generate} ) { + my $generator = delete $args{generate}; + my $otherwise = delete $args{otherwise}; + + # TODO: This is slightly messy as this lexical is captured by both + # blocks of code. Can we do better somehow? + my $done; + + my $orig_code = $code; + $code = sub { + my ( $last_trial_f ) = @_; + my $again = my ( $value ) = $generator->( $last_trial_f ); + + if( $again ) { + unshift @_, $value; goto &$orig_code; + } + + $done++; + if( $otherwise ) { + goto &$otherwise; + } + else { + return $last_trial_f || Future->done; + } + }; + + if( my $orig_while = delete $args{while} ) { + $args{while} = sub { + $orig_while->( $_[0] ) and !$done; + }; + } + elsif( my $orig_until = delete $args{until} ) { + $args{while} = sub { + !$orig_until->( $_[0] ) and !$done; + }; + } + else { + $args{while} = sub { !$done }; + } + } + + my $future = $args{return}; + + my $trial; + $args{while} and $future = _repeat( $code, $future, \$trial, $args{while}, 0, $args{try} ); + $args{until} and $future = _repeat( $code, $future, \$trial, $args{until}, 1, $args{try} ); + + $future->on_cancel( sub { $trial->cancel } ); + + return $future; +} + +=head2 $future = try_repeat { CODE } ... + +A variant of C<repeat> that doesn't warn when the trial fails and the +condition code asks for it to be repeated. + +In some later version the C<repeat> function will be changed so that if a +trial future fails, then the eventual future will immediately fail as well, +making its semantics a little closer to that of a C<while {}> loop in Perl. +Code that specifically wishes to catch failures in trial futures and retry +the block should use C<try_repeat> specifically. + +=cut + +sub try_repeat(&@) +{ + # defeat prototype + &repeat( @_, try => 1 ); +} + +=head2 $future = try_repeat_until_success { CODE } ... + +A shortcut to calling C<try_repeat> with an ending condition that simply tests +for a successful result from a future. May be combined with C<foreach> or +C<generate>. + +This function used to be called C<repeat_until_success>, and is currently +aliased as this name as well. + +=cut + +sub try_repeat_until_success(&@) +{ + my $code = shift; + my %args = @_; + + # TODO: maybe merge while/until conditions one day... + defined($args{while}) or defined($args{until}) + and croak "Cannot pass 'while' or 'until' to try_repeat_until_success"; + + # defeat prototype + &try_repeat( $code, while => sub { shift->failure }, %args ); +} + +# Legacy name +*repeat_until_success = \&try_repeat_until_success; + +=head1 APPLYING A FUNCTION TO A LIST + +The C<fmap> family of functions provide a way to call a block of code that +returns a L<Future> (called here an "item future") once per item in a given +list, or returned by a generator function. The C<fmap*> functions themselves +return a C<Future> to represent the ongoing operation, which completes when +every item's future has completed. + +While this behaviour can also be implemented using C<repeat>, the main reason +to use an C<fmap> function is that the individual item operations are +considered as independent, and thus more than one can be outstanding +concurrently. An argument can be passed to the function to indicate how many +items to start initially, and thereafter it will keep that many of them +running concurrently until all of the items are done, or until any of them +fail. If an individual item future fails, the overall result future will be +marked as failing with the same failure, and any other pending item futures +that are outstanding at the time will be cancelled. + +The following named arguments are common to each C<fmap*> function: + +=over 8 + +=item foreach => ARRAY + +Provides the list of items to iterate over, as an C<ARRAY> reference. + +The referenced array will be modified by this operation, C<shift>ing one item +from it each time. The can C<push> more items to this array as it runs, and +they will be included in the iteration. + +=item generate => CODE + +Provides the list of items to iterate over, by calling the generator function +once for each required item. The function should return a single item, or an +empty list to indicate it has no more items. + + ( $item ) = $generate->() + +This function will be invoked each time any previous item future has completed +and may be called again even after it has returned empty. + +=item concurrent => INT + +Gives the number of item futures to keep outstanding. By default this value +will be 1 (i.e. no concurrency); larger values indicate that multiple item +futures will be started at once. + +=item return => Future + +Normally, a new instance is returned by cloning the first non-immediate future +returned as an item future. By passing a new instance as the C<return> +argument, the result will be put into the given instance. This can be used to +return subclasses, or specific instances. + +=back + +In each case, the main code block will be called once for each item in the +list, passing in the item as the only argument: + + $item_f = $code->( $item ) + +The expected return value from each item's future, and the value returned from +the result future will differ in each function's case; they are documented +below. + +=cut + +# This function is invoked in two circumstances: +# a) to create an item Future in a slot, +# b) once a non-immediate item Future is complete, to check its results +# It can tell which circumstance by whether the slot itself is defined or not +sub _fmap_slot +{ + my ( $slots, undef, $code, $generator, $collect, $results, $return ) = @_; + + SLOT: while(1) { + # Capture args each call because we mutate them + my ( undef, $idx ) = my @args = @_; + + unless( $slots->[$idx] ) { + # No item Future yet (case a), so create one + my $item; + unless( ( $item ) = $generator->() ) { + # All out of items, so now just wait for the slots to be finished + undef $slots->[$idx]; + defined and return $return for @$slots; + + # All the slots are done + $return ||= Future->new; + + $return->done( @$results ); + return $return; + } + + my $f = $slots->[$idx] = Future->call( $code, $item ); + + if( $collect eq "array" ) { + push @$results, my $r = []; + $f->on_done( sub { @$r = @_ }); + } + elsif( $collect eq "scalar" ) { + push @$results, undef; + my $r = \$results->[-1]; + $f->on_done( sub { $$r = $_[0] }); + } + } + + my $f = $slots->[$idx]; + + # Slot is non-immediate; arrange for us to be invoked again later when it's ready + if( !$f->is_ready ) { + $args[-1] = ( $return ||= $f->new ); + $f->on_done( sub { _fmap_slot( @args ) } ); + $f->on_fail( $return ); + + # Try looking for more that might be ready + my $i = $idx + 1; + while( $i != $idx ) { + $i++; + $i %= @$slots; + next if defined $slots->[$i]; + + $_[1] = $i; + redo SLOT; + } + return $return; + } + + # Either we've been invoked again (case b), or the immediate Future was + # already ready. + if( $f->failure ) { + $return ||= $f->new; + $return->fail( $f->failure ); + return $return; + } + + undef $slots->[$idx]; + # next + } +} + +sub _fmap +{ + my $code = shift; + my %args = @_; + + my $concurrent = $args{concurrent} || 1; + my @slots; + + my $results = []; + my $future = $args{return}; + + my $generator; + if( $generator = $args{generate} ) { + # OK + } + elsif( my $array = $args{foreach} ) { + $generator = sub { return unless @$array; shift @$array }; + } + else { + croak "Expected either 'generate' or 'foreach'"; + } + + # If any of these immediately fail, don't bother continuing + foreach my $idx ( 0 .. $concurrent-1 ) { + $future = _fmap_slot( \@slots, $idx, $code, $generator, $args{collect}, $results, $future ); + last if $future->is_ready; + } + + $future->on_fail( sub { + !defined $_ or $_->is_ready or $_->cancel for @slots; + }); + $future->on_cancel( sub { + $_->cancel for @slots; + }); + + return $future; +} + +=head2 $future = fmap_concat { CODE } ... + +This version of C<fmap> expects each item future to return a list of zero or +more values, and the overall result will be the concatenation of all these +results. It acts like a future-based equivalent to Perl's C<map> operator. + +The results are returned in the order of the original input values, not in the +order their futures complete in. Because of the intermediate storage of +C<ARRAY> references and final flattening operation used to implement this +behaviour, this function is slightly less efficient than C<fmap_scalar> or +C<fmap_void> in cases where item futures are expected only ever to return one, +or zero values, respectively. + +This function is also available under the name of simply C<fmap> to emphasise +its similarity to perl's C<map> keyword. + +=cut + +sub fmap_concat(&@) +{ + my $code = shift; + my %args = @_; + + _fmap( $code, %args, collect => "array" )->then( sub { + return Future->done( map { @$_ } @_ ); + }); +} +*fmap = \&fmap_concat; + +=head2 $future = fmap_scalar { CODE } ... + +This version of C<fmap> acts more like the C<map> functions found in Scheme or +Haskell; it expects that each item future returns only one value, and the +overall result will be a list containing these, in order of the original input +items. If an item future returns more than one value the others will be +discarded. If it returns no value, then C<undef> will be substituted in its +place so that the result list remains in correspondence with the input list. + +This function is also available under the shorter name of C<fmap1>. + +=cut + +sub fmap_scalar(&@) +{ + my $code = shift; + my %args = @_; + + _fmap( $code, %args, collect => "scalar" ) +} +*fmap1 = \&fmap_scalar; + +=head2 $future = fmap_void { CODE } ... + +This version of C<fmap> does not collect any results from its item futures, it +simply waits for them all to complete. Its result future will provide no +values. + +While not a map in the strictest sense, this variant is still useful as a way +to control concurrency of a function call iterating over a list of items, +obtaining its results by some other means (such as side-effects on captured +variables, or some external system). + +This function is also available under the shorter name of C<fmap0>. + +=cut + +sub fmap_void(&@) +{ + my $code = shift; + my %args = @_; + + _fmap( $code, %args, collect => "void" ) +} +*fmap0 = \&fmap_void; + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut + +0x55AA; diff --git a/lib/Test/Future.pm b/lib/Test/Future.pm new file mode 100644 index 0000000..f2a7d5f --- /dev/null +++ b/lib/Test/Future.pm @@ -0,0 +1,141 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2014 -- leonerd@leonerd.org.uk + +package Test::Future; + +use strict; +use warnings; +use base qw( Test::Builder::Module ); + +our $VERSION = '0.32'; + +our @EXPORT = qw( + no_pending_futures +); + +use Scalar::Util qw( refaddr ); + +use constant HAVE_DEVEL_MAT_DUMPER => defined eval { require Devel::MAT::Dumper }; + +=head1 NAME + +C<Test::Future> - unit test assertions for L<Future> instances + +=head1 SYNOPSIS + + use Test::More tests => 2; + use Test::Future; + + no_pending_futures { + my $f = some_function(); + + is( $f->get, "result", 'Result of the some_function()' ); + } 'some_function() leaves no pending Futures'; + +=head1 DESCRIPTION + +This module provides unit testing assertions that may be useful when testing +code based on, or using L<Future> instances or subclasses. + +=cut + +=head1 FUNCTIONS + +=cut + +=head2 no_pending_futures( \&code, $name ) + +Runs the given block of code, while keeping track of every C<Future> instance +constructed while doing so. After the code has returned, each of these +instances are inspected to check that they are not still pending. If they are +all either ready (by success or failure) or cancelled, the test will pass. If +any are still pending then the test fails. + +If L<Devel::MAT> is installed, it will be used to write a memory state dump +after a failure. It will create a F<.pmat> file named the same as the unit +test, but with the trailing F<.t> suffix replaced with F<-TEST.pmat> where +C<TEST> is the number of the test that failed (in case there was more than +one). A list of addresses of C<Future> instances that are still pending is +also printed to assist in debugging the issue. + +It is not an error if the code does not construct any C<Future> instances at +all. The block of code may contain other testing assertions; they will be run +before the assertion by C<no_pending_futures> itself. + +=cut + +sub no_pending_futures(&@) +{ + my ( $code, $name ) = @_; + + my @futures; + + no warnings 'redefine'; + + my $new = Future->can( "new" ); + local *Future::new = sub { + my $f = $new->(@_); + push @futures, $f; + $f->on_ready( sub { + my $f = shift; + for ( 0 .. $#futures ) { + refaddr( $futures[$_] ) == refaddr( $f ) or next; + + splice @futures, $_, 1, (); + return; + } + }); + return $f; + }; + + my $done = Future->can( "done" ); + local *Future::done = sub { + my $f = $done->(@_); + pop @futures if !ref $_[0]; # class method + return $f; + }; + + my $fail = Future->can( "fail" ); + local *Future::fail = sub { + my $f = $fail->(@_); + pop @futures if !ref $_[0]; # class method + return $f; + }; + + my $tb = __PACKAGE__->builder; + + $code->(); + + my @pending = grep { !$_->is_ready } @futures; + + return $tb->ok( 1, $name ) if !@pending; + + my $ok = $tb->ok( 0, $name ); + + $tb->diag( "The following Futures are still pending:" ); + $tb->diag( join ", ", map { sprintf "0x%x", refaddr $_ } @pending ); + + if( HAVE_DEVEL_MAT_DUMPER ) { + my $file = $0; + my $num = $tb->current_test; + + # Trim the .t off first then append -$num.pmat, in case $0 wasn't a .t file + $file =~ s/\.(?:t|pm|pl)$//; + $file .= "-$num.pmat"; + + $tb->diag( "Writing heap dump to $file" ); + Devel::MAT::Dumper::dump( $file ); + } + + return $ok; +} + +=head1 AUTHOR + +Paul Evans <leonerd@leonerd.org.uk> + +=cut + +0x55AA; diff --git a/t/00use.t b/t/00use.t new file mode 100644 index 0000000..dc88b8a --- /dev/null +++ b/t/00use.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use_ok( "Future" ); +use_ok( "Future::Utils" ); + +done_testing; diff --git a/t/01future.t b/t/01future.t new file mode 100644 index 0000000..03fb2db --- /dev/null +++ b/t/01future.t @@ -0,0 +1,290 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; +use Test::Refcount; + +use Future; + +# done +{ + my $future = Future->new; + + ok( defined $future, '$future defined' ); + isa_ok( $future, "Future", '$future' ); + is_oneref( $future, '$future has refcount 1 initially' ); + + ok( !$future->is_ready, '$future not yet ready' ); + + my @on_ready_args; + identical( $future->on_ready( sub { @on_ready_args = @_ } ), $future, '->on_ready returns $future' ); + + my @on_done_args; + identical( $future->on_done( sub { @on_done_args = @_ } ), $future, '->on_done returns $future' ); + identical( $future->on_fail( sub { die "on_fail called for done future" } ), $future, '->on_fail returns $future' ); + + identical( $future->done( result => "here" ), $future, '->done returns $future' ); + + is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' ); + identical( $on_ready_args[0], $future, 'Future passed to on_ready' ); + undef @on_ready_args; + + is_deeply( \@on_done_args, [ result => "here" ], 'Results passed to on_done' ); + + ok( $future->is_ready, '$future is now ready' ); + ok( $future->is_done, '$future is done' ); + ok( !$future->is_failed, '$future is not failed' ); + is_deeply( [ $future->get ], [ result => "here" ], 'Results from $future->get' ); + is( scalar $future->get, "result", 'Result from scalar $future->get' ); + + is_oneref( $future, '$future has refcount 1 at end of test' ); +} + +# wrap +{ + my $f = Future->new; + + my $future = Future->wrap( $f ); + + ok( defined $future, 'Future->wrap(Future) defined' ); + isa_ok( $future, "Future", 'Future->wrap(Future)' ); + + $f->done( "Wrapped Future" ); + is( scalar $future->get, "Wrapped Future", 'Future->wrap(Future)->get' ); + + $future = Future->wrap( "Plain string" ); + + ok( defined $future, 'Future->wrap(string) defined' ); + isa_ok( $future, "Future", 'Future->wrap(string)' ); + + is( scalar $future->get, "Plain string", 'Future->wrap(string)->get' ); +} + +# done_cb +{ + my $future = Future->new; + + my @on_done_args; + $future->on_done( sub { @on_done_args = @_ } ); + + my $done_cb = $future->done_cb; + is( ref $done_cb, "CODE", '->done_cb returns CODE reference' ); + + $done_cb->( result => "via cb" ); + is_deeply( \@on_done_args, [ result => "via cb" ], 'Results via ->done_cb' ); +} + +# done chaining +{ + my $future = Future->new; + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_done( $f1 ); + $future->on_ready( $f2 ); + + my @on_done_args_1; + $f1->on_done( sub { @on_done_args_1 = @_ } ); + my @on_done_args_2; + $f2->on_done( sub { @on_done_args_2 = @_ } ); + + $future->done( chained => "result" ); + + is_deeply( \@on_done_args_1, [ chained => "result" ], 'Results chained via ->on_done( $f )' ); + is_deeply( \@on_done_args_2, [ chained => "result" ], 'Results chained via ->on_ready( $f )' ); +} + +# immediately done +{ + my $future = Future->done( already => "done" ); + + my @on_done_args; + identical( $future->on_done( sub { @on_done_args = @_; } ), $future, '->on_done returns future for immediate' ); + my $on_fail; + identical( $future->on_fail( sub { $on_fail++; } ), $future, '->on_fail returns future for immediate' ); + + is_deeply( \@on_done_args, [ already => "done" ], 'Results passed to on_done for immediate future' ); + ok( !$on_fail, 'on_fail not invoked for immediate future' ); + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_done( $f1 ); + $future->on_ready( $f2 ); + + ok( $f1->is_ready, 'Chained ->on_done for immediate future' ); + ok( $f1->is_done, 'Chained ->on_done is done for immediate future' ); + is_deeply( [ $f1->get ], [ already => "done" ], 'Results from chained via ->on_done for immediate future' ); + ok( $f2->is_ready, 'Chained ->on_ready for immediate future' ); + ok( $f2->is_done, 'Chained ->on_ready is done for immediate future' ); + is_deeply( [ $f2->get ], [ already => "done" ], 'Results from chained via ->on_ready for immediate future' ); +} + +# fail +{ + my $future = Future->new; + + $future->on_done( sub { die "on_done called for failed future" } ); + my $failure; + $future->on_fail( sub { ( $failure ) = @_; } ); + + identical( $future->fail( "Something broke" ), $future, '->fail returns $future' ); + + ok( $future->is_ready, '$future->fail marks future ready' ); + ok( !$future->is_done, '$future->fail does not mark future done' ); + ok( $future->is_failed, '$future->fail marks future as failed' ); + + is( scalar $future->failure, "Something broke", '$future->failure yields exception' ); + my $file = __FILE__; + my $line = __LINE__ + 1; + like( exception { $future->get }, qr/^Something broke at \Q$file line $line\E\.?\n$/, '$future->get throws exception' ); + + is( $failure, "Something broke", 'Exception passed to on_fail' ); +} + +# fail_cb +{ + my $future = Future->new; + + my $failure; + $future->on_fail( sub { ( $failure ) = @_ } ); + + my $fail_cb = $future->fail_cb; + is( ref $fail_cb, "CODE", '->fail_cb returns CODE reference' ); + + $fail_cb->( "Failure by cb" ); + is( $failure, "Failure by cb", 'Failure via ->fail_cb' ); +} + +{ + my $future = Future->new; + + $future->fail( "Something broke", further => "details" ); + + ok( $future->is_ready, '$future->fail marks future ready' ); + + is( scalar $future->failure, "Something broke", '$future->failure yields exception' ); + is_deeply( [ $future->failure ], [ "Something broke", "further", "details" ], + '$future->failure yields details in list context' ); +} + +# fail chaining +{ + my $future = Future->new; + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_fail( $f1 ); + $future->on_ready( $f2 ); + + my $failure_1; + $f1->on_fail( sub { ( $failure_1 ) = @_ } ); + my $failure_2; + $f2->on_fail( sub { ( $failure_2 ) = @_ } ); + + $future->fail( "Chained failure" ); + + is( $failure_1, "Chained failure", 'Failure chained via ->on_fail( $f )' ); + is( $failure_2, "Chained failure", 'Failure chained via ->on_ready( $f )' ); +} + +# immediately failed +{ + my $future = Future->fail( "Already broken" ); + + my $on_done; + identical( $future->on_done( sub { $on_done++; } ), $future, '->on_done returns future for immediate' ); + my $failure; + identical( $future->on_fail( sub { ( $failure ) = @_; } ), $future, '->on_fail returns future for immediate' ); + + is( $failure, "Already broken", 'Exception passed to on_fail for already-failed future' ); + ok( !$on_done, 'on_done not invoked for immediately-failed future' ); + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_fail( $f1 ); + $future->on_ready( $f2 ); + + ok( $f1->is_ready, 'Chained ->on_done for immediate future' ); + is_deeply( [ $f1->failure ], [ "Already broken" ], 'Results from chained via ->on_done for immediate future' ); + ok( $f2->is_ready, 'Chained ->on_ready for immediate future' ); + is_deeply( [ $f2->failure ], [ "Already broken" ], 'Results from chained via ->on_ready for immediate future' ); +} + +# die +{ + my $future = Future->new; + + $future->on_done( sub { die "on_done called for failed future" } ); + my $failure; + $future->on_fail( sub { ( $failure ) = @_; } ); + + my $file = __FILE__; + my $line = __LINE__+1; + identical( $future->die( "Something broke" ), $future, '->die returns $future' ); + + ok( $future->is_ready, '$future->die marks future ready' ); + + is( scalar $future->failure, "Something broke at $file line $line\n", '$future->failure yields exception' ); + is( exception { $future->get }, "Something broke at $file line $line\n", '$future->get throws exception' ); + + is( $failure, "Something broke at $file line $line\n", 'Exception passed to on_fail' ); +} + +# call +{ + my $future; + + $future = Future->call( sub { Future->done( @_ ) }, 1, 2, 3 ); + + ok( $future->is_ready, '$future->is_ready from immediate Future->call' ); + is_deeply( [ $future->get ], [ 1, 2, 3 ], '$future->get from immediate Future->call' ); + + $future = Future->call( sub { die "argh!\n" } ); + + ok( $future->is_ready, '$future->is_ready from immediate exception of Future->call' ); + is( $future->failure, "argh!\n", '$future->failure from immediate exception of Future->call' ); + + $future = Future->call( sub { "non-future" } ); + + ok( $future->is_ready, '$future->is_ready from non-future returning Future->call' ); + like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, + '$future->failure from non-future returning Future->call' ); +} + +# unwrap +{ + is_deeply( [ Future->unwrap( Future->done( 1, 2, 3 ) ) ], + [ 1, 2, 3 ], + 'Future->unwrap Future in list context' ); + is_deeply( [ Future->unwrap( 1, 2, 3 ) ], + [ 1, 2, 3 ], + 'Future->unwrap plain list in list context' ); + + is( scalar Future->unwrap( Future->done( qw( a b c ) ) ), + "a", + 'Future->unwrap Future in scalar context' ); + is( scalar Future->unwrap( qw( a b c ) ), + "a", + 'Future->unwrap plain list in scalar context' ); +} + +# label +{ + my $f = Future->new; + + identical( $f->set_label( "the label" ), $f, '->set_label returns $f' ); + + is( $f->label, "the label", '->label returns the label' ); + + $f->cancel; +} + +done_testing; diff --git a/t/02cancel.t b/t/02cancel.t new file mode 100644 index 0000000..bea0e3b --- /dev/null +++ b/t/02cancel.t @@ -0,0 +1,131 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; + +use Future; + +# cancel +{ + my $future = Future->new; + + my $cancelled; + + identical( $future->on_cancel( sub { $cancelled .= "1" } ), $future, '->on_cancel returns $future' ); + $future->on_cancel( sub { $cancelled .= "2" } ); + + my $ready; + $future->on_ready( sub { $ready++ if shift->is_cancelled } ); + + $future->on_done( sub { die "on_done called for cancelled future" } ); + $future->on_fail( sub { die "on_fail called for cancelled future" } ); + + $future->on_ready( my $ready_f = Future->new ); + $future->on_done( my $done_f = Future->new ); + $future->on_fail( my $fail_f = Future->new ); + + $future->cancel; + + ok( $future->is_ready, '$future->cancel marks future ready' ); + + ok( $future->is_cancelled, '$future->cancelled now true' ); + is( $cancelled, "21", '$future cancel blocks called in reverse order' ); + + is( $ready, 1, '$future on_ready still called by cancel' ); + + ok( $ready_f->is_cancelled, 'on_ready chained future cnacelled after cancel' ); + ok( !$done_f->is_ready, 'on_done chained future not ready after cancel' ); + ok( !$fail_f->is_ready, 'on_fail chained future not ready after cancel' ); + + like( exception { $future->get }, qr/cancelled/, '$future->get throws exception by cancel' ); + + ok( !exception { $future->cancel }, '$future->cancel a second time is OK' ); + + $done_f->cancel; + $fail_f->cancel; +} + +# cancel_cb +{ + my $future = Future->new; + + my $cancelled; + $future->on_cancel( sub { $cancelled++ } ); + + my $cancel_cb = $future->cancel_cb; + is( ref $cancel_cb, "CODE", '->cancel_cb returns CODE reference' ); + + $cancel_cb->(); + is( $cancelled, 1, 'Cancellation via ->cancel_cb' ); +} + +# immediately cancelled +{ + my $future = Future->new; + $future->cancel; + + my $ready_called; + $future->on_ready( sub { $ready_called++ } ); + my $done_called; + $future->on_done( sub { $done_called++ } ); + my $fail_called; + $future->on_fail( sub { $fail_called++ } ); + + $future->on_ready( my $ready_f = Future->new ); + $future->on_done( my $done_f = Future->new ); + $future->on_fail( my $fail_f = Future->new ); + + is( $ready_called, 1, 'on_ready invoked for already-cancelled future' ); + ok( !$done_called, 'on_done not invoked for already-cancelled future' ); + ok( !$fail_called, 'on_fail not invoked for already-cancelled future' ); + + ok( $ready_f->is_cancelled, 'on_ready chained future cnacelled for already-cancelled future' ); + ok( !$done_f->is_ready, 'on_done chained future not ready for already-cancelled future' ); + ok( !$fail_f->is_ready, 'on_fail chained future not ready for already-cancelled future' ); + + $done_f->cancel; + $fail_f->cancel; +} + +# cancel chaining +{ + my $f1 = Future->new; + my $f2 = Future->new; + + $f1->on_cancel( $f2 ); + my $cancelled; + $f2->on_cancel( sub { $cancelled++ } ); + + $f1->cancel; + is( $cancelled, 1, 'Chained cancellation' ); +} + +# ->done on cancelled +{ + my $f = Future->new; + $f->cancel; + + ok( eval { $f->done( "ignored" ); 1 }, '->done on cancelled future is ignored' ); + ok( eval { $f->fail( "ignored" ); 1 }, '->fail on cancelled future is ignored' ); +} + +# without_cancel +{ + my $f1 = Future->new; + my $f2 = $f1->without_cancel; + + $f2->cancel; + ok( !$f1->is_cancelled, '$f1 not cancelled just because $f2 is' ); + + my $f3 = $f1->without_cancel; + $f1->done( "result" ); + + ok( $f3->is_ready, '$f3 ready when $f1 is' ); + is_deeply( [ $f3->get ], [ "result" ], 'result of $f3' ); +} + +done_testing; diff --git a/t/03then.t b/t/03then.t new file mode 100644 index 0000000..9daea09 --- /dev/null +++ b/t/03then.t @@ -0,0 +1,290 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; +use Test::Identity; + +use Future; + +# then success +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->then( + sub { + is( $_[0], "f1 result", 'then done block passed result of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + ok( !$f2, '$f2 not yet defined before $f1 done' ); + + $f1->done( "f1 result" ); + + ok( defined $f2, '$f2 now defined after $f1 done' ); + + undef $f1; + is_oneref( $fseq, '$fseq has refcount 1 after $f1 done and dropped' ); + + ok( !$fseq->is_ready, '$fseq not yet done before $f2 done' ); + + $f2->done( results => "here" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); + + undef $f2; + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# then failure in f1 +{ + my $f1 = Future->new; + + my $fseq = $f1->then( + sub { die "then of failed Future should not be invoked" } + ); + + $f1->fail( "A failure\n" ); + + ok( $fseq->is_ready, '$fseq is now ready after $f1 fail' ); + + is( scalar $fseq->failure, "A failure\n", '$fseq fails when $f1 fails' ); +} + +# then failure in f2 +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->then( + sub { return $f2 = Future->new } + ); + + $f1->done; + $f2->fail( "Another failure\n" ); + + ok( $fseq->is_ready, '$fseq is now ready after $f2 fail' ); + + is( scalar $fseq->failure, "Another failure\n", '$fseq fails when $f2 fails' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $fseq = $f1->then( sub { + die "It fails\n"; + } ); + + ok( !defined exception { $f1->done }, 'exception not propagated from done call' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); +} + +# immediately done +{ + my $f1 = Future->done( "Result" ); + + my $f2; + my $fseq = $f1->then( + sub { return $f2 = Future->new } + ); + + ok( defined $f2, '$f2 defined for immediate done' ); + + $f2->done( "Final" ); + + ok( $fseq->is_ready, '$fseq already ready for immediate done' ); + is( scalar $fseq->get, "Final", '$fseq->get for immediate done' ); +} + +# immediately fail +{ + my $f1 = Future->fail( "Failure\n" ); + + my $fseq = $f1->then( + sub { die "then of immediately-failed future should not be invoked" } + ); + + ok( $fseq->is_ready, '$fseq already ready for immediate fail' ); + is( scalar $fseq->failure, "Failure\n", '$fseq->failure for immediate fail' ); +} + +# done fallthrough +{ + my $f1 = Future->new; + my $fseq = $f1->then; + + $f1->done( "fallthrough result" ); + + ok( $fseq->is_ready, '$fseq is ready' ); + is( scalar $fseq->get, "fallthrough result", '->then done fallthrough' ); +} + +# fail fallthrough +{ + my $f1 = Future->new; + my $fseq = $f1->then; + + $f1->fail( "fallthrough failure\n" ); + + ok( $fseq->is_ready, '$fseq is ready' ); + is( scalar $fseq->failure, "fallthrough failure\n", '->then fail fallthrough' ); +} + +# then cancel +{ + my $f1 = Future->new; + my $fseq = $f1->then( sub { die "then done of cancelled Future should not be invoked" } ); + + $fseq->cancel; + + ok( $f1->is_cancelled, '$f1 is cancelled by $fseq cancel' ); + + $f1 = Future->new; + my $f2; + $fseq = $f1->then( sub { return $f2 = Future->new } ); + + $f1->done; + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq cancel' ); +} + +# then dropping $fseq doesn't fail ->done +{ + local $SIG{__WARN__} = sub {}; + + my $f1 = Future->new; + my $fseq = $f1->then( sub { return Future->done() } ); + + undef $fseq; + + is( exception { $f1->done; }, undef, + 'Dropping $fseq does not cause $f1->done to die' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->then( + sub { Future->new } + ); + like( $warnings, + qr/^Calling ->then in void context /, + 'Warning in void context' ); +} + +# Non-Future return raises exception +{ + my $f1 = Future->new; + + my $file = __FILE__; + my $line = __LINE__+1; + my $fseq = $f1->then( sub {} ); + my $fseq2 = $f1->then( sub { Future->done } ); + + ok( !exception { $f1->done }, + '->done with non-Future return from ->then does not die' ); + + like( $fseq->failure, + qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, + 'Failure from non-Future return from ->then' ); + + ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); + + my $fseq3; + ok( !exception { $fseq3 = $f1->then( sub {} ) }, + 'non-Future return from ->then on immediate does not die' ); + + like( $fseq3->failure, + qr/^Expected __ANON__\(.*\) to return a Future/, + 'Failure from non-Future return from ->then on immediate' ); +} + +# then_with_f +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->then_with_f( + sub { + identical( $_[0], $f1, 'then_with_f block passed $f1' ); + is( $_[1], "f1 result", 'then_with_f block pased result of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + + $f1->done( "f1 result" ); + + ok( defined $f2, '$f2 defined after $f1->done' ); + + $f2->done( "f2 result" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is( scalar $fseq->get, "f2 result", '$fseq->get returns results' ); +} + +# then_done +{ + my $f1 = Future->new; + + my $fseq = $f1->then_done( second => "result" ); + + $f1->done( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->get ], [ second => "result" ], '$fseq->get returns result for then_done' ); + + my $fseq2 = $f1->then_done( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->then_done on immediate' ); + is_deeply( [ $fseq2->get ], [ third => "result" ], '$fseq2->get returns result for then_done on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->then_done( "result" ); + $f2->fail( "failure" ); + + is( scalar $fseq->failure, "failure", '->then_done ignores failure' ); +} + +# then_fail +{ + my $f1 = Future->new; + + my $fseq = $f1->then_fail( second => "result" ); + + $f1->done( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->failure ], [ second => "result" ], '$fseq->failure returns result for then_fail' ); + + my $fseq2 = $f1->then_fail( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->then_fail on immediate' ); + is_deeply( [ $fseq2->failure ], [ third => "result" ], '$fseq2->failure returns result for then_fail on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->then_fail( "fail2" ); + $f2->fail( "failure" ); + + is( scalar $fseq->failure, "failure", '->then_fail ignores failure' ); +} + +done_testing; diff --git a/t/04else.t b/t/04else.t new file mode 100644 index 0000000..2cbc546 --- /dev/null +++ b/t/04else.t @@ -0,0 +1,259 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; +use Test::Identity; + +use Future; + +# else success +{ + my $f1 = Future->new; + + my $fseq = $f1->else( + sub { die "else of successful Future should not be invoked" } + ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + $f1->done( results => "here" ); + + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq succeeds when $f1 succeeds' ); + + undef $f1; + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# else failure +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->else( + sub { + is( $_[0], "f1 failure\n", 'then fail block passed result of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + ok( !$f2, '$f2 not yet defined before $f1 fails' ); + + $f1->fail( "f1 failure\n" ); + + undef $f1; + is_oneref( $fseq, '$fseq has refcount 1 after $f1 fail and dropped' ); + + ok( defined $f2, '$f2 now defined after $f1 fails' ); + + ok( !$fseq->is_ready, '$fseq not yet done before $f2 done' ); + + $f2->done( results => "here" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); + + undef $f2; + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# Double failure +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->else( + sub { return $f2 = Future->new } + ); + + $f1->fail( "First failure\n" ); + $f2->fail( "Another failure\n" ); + + is( scalar $fseq->failure, "Another failure\n", '$fseq fails when $f2 fails' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $fseq = $f1->else( sub { + die "It fails\n"; + } ); + + ok( !defined exception { $f1->fail( "bork" ) }, 'exception not propagated from fail call' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); +} + +# immediate fail +{ + my $f1 = Future->fail( "Failure\n" ); + + my $f2; + my $fseq = $f1->else( + sub { return $f2 = Future->new } + ); + + ok( defined $f2, '$f2 defined for immediate fail' ); + + $f2->fail( "Another failure\n" ); + + ok( $fseq->is_ready, '$fseq already ready for immediate fail' ); + is( scalar $fseq->failure, "Another failure\n", '$fseq->failure for immediate fail' ); +} + +# immediate done +{ + my $f1 = Future->done( "It works" ); + + my $fseq = $f1->else( + sub { die "else block invoked for immediate done Future" } + ); + + ok( $fseq->is_ready, '$fseq already ready for immediate done' ); + is( scalar $fseq->get, "It works", '$fseq->get for immediate done' ); +} + +# else cancel +{ + my $f1 = Future->new; + my $fseq = $f1->else( sub { die "else of cancelled Future should not be invoked" } ); + + $fseq->cancel; + + ok( $f1->is_cancelled, '$f1 is cancelled by $fseq cancel' ); + + $f1 = Future->new; + my $f2; + $fseq = $f1->else( sub { return $f2 = Future->new } ); + + $f1->fail( "A failure\n" ); + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq cancel' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->else( + sub { Future->new } + ); + like( $warnings, + qr/^Calling ->else in void context /, + 'Warning in void context' ); +} + +# Non-Future return raises exception +{ + my $f1 = Future->new; + + my $file = __FILE__; + my $line = __LINE__+1; + my $fseq = $f1->else( sub {} ); + my $fseq2 = $f1->else( sub { Future->done } ); + + ok( !exception { $f1->fail( "failed\n" ) }, + '->fail with non-Future return from ->else does not die' ); + + like( $fseq->failure, + qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, + 'Failure from non-Future return from ->else' ); + + ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); + + my $fseq3; + ok( !exception { $fseq3 = $f1->else( sub {} ) }, + 'non-Future return from ->else on immediate does not die' ); + + like( $fseq3->failure, + qr/^Expected __ANON__\(.*\) to return a Future/, + 'Failure from non-Future return from ->else on immediate' ); +} + +# else_with_f +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->else_with_f( + sub { + identical( $_[0], $f1, 'else_with_f block passed $f1' ); + is( $_[1], "f1 failure\n", 'else_with_f block pased failure of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + + $f1->fail( "f1 failure\n" ); + + ok( defined $f2, '$f2 defined after $f1->fail' ); + + $f2->done( "f2 result" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is( scalar $fseq->get, "f2 result", '$fseq->get returns results' ); +} + +# else_done +{ + my $f1 = Future->new; + + my $fseq = $f1->else_done( second => "result" ); + + $f1->fail( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->get ], [ second => "result" ], '$fseq->get returns result for else_done' ); + + my $fseq2 = $f1->else_done( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->else_done on immediate' ); + is_deeply( [ $fseq2->get ], [ third => "result" ], '$fseq2->get returns result for else_done on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->else_done( "result2" ); + $f2->done( "result" ); + + is( scalar $fseq->get, "result", '->else_done ignores success' ); +} + +# else_fail +{ + my $f1 = Future->new; + + my $fseq = $f1->else_fail( second => "result" ); + + $f1->fail( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->failure ], [ second => "result" ], '$fseq->failure returns result for else_fail' ); + + my $fseq2 = $f1->else_fail( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->else_fail on immediate' ); + is_deeply( [ $fseq2->failure ], [ third => "result" ], '$fseq2->failure returns result for else_fail on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->else_fail( "failure" ); + $f2->done( "result" ); + + is( scalar $fseq->get, "result", '->else_fail ignores success' ); +} + +done_testing; diff --git a/t/05then-else.t b/t/05then-else.t new file mode 100644 index 0000000..ff35ac7 --- /dev/null +++ b/t/05then-else.t @@ -0,0 +1,78 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Future; + +# then done +{ + my $f1 = Future->new; + + my $fdone; + my $fseq = $f1->then( + sub { + is( $_[0], "f1 result", '2-arg then done block passed result of $f1' ); + return $fdone = Future->new; + }, + sub { + die "then fail block should not be invoked"; + }, + ); + + $f1->done( "f1 result" ); + + ok( defined $fdone, '$fdone now defined after $f1 done' ); + + $fdone->done( results => "here" ); + + ok( $fseq->is_ready, '$fseq is done after $fdone done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); +} + +# then fail +{ + my $f1 = Future->new; + + my $ffail; + my $fseq = $f1->then( + sub { + die "then done block should not be invoked"; + }, + sub { + is( $_[0], "The failure\n", '2-arg then fail block passed failure of $f1' ); + return $ffail = Future->new; + }, + ); + + $f1->fail( "The failure\n" ); + + ok( defined $ffail, '$ffail now defined after $f1 fail' ); + + $ffail->done( fallback => "result" ); + + ok( $fseq->is_ready, '$fseq is done after $ffail fail' ); + is_deeply( [ $fseq->get ], [ fallback => "result" ], '$fseq->get returns results' ); +} + +# then done fails doesn't trigger fail block +{ + my $f1 = Future->new; + + my $fdone; + my $fseq = $f1->then( + sub { $fdone = Future->new; }, + sub { die "then fail block should not be invoked"; }, + ); + + $f1->done( "Done" ); + $fdone->fail( "The failure\n" ); + + ok( $fseq->is_ready, '$fseq is ready after $fdone fail' ); + ok( scalar $fseq->failure, '$fseq failed after $fdone fail' ); +} + +done_testing; diff --git a/t/06followed_by.t b/t/06followed_by.t new file mode 100644 index 0000000..3c9418d --- /dev/null +++ b/t/06followed_by.t @@ -0,0 +1,197 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; +use Test::Refcount; + +use Future; + +{ + my $f1 = Future->new; + + my $called = 0; + my $fseq = $f1->followed_by( sub { + $called++; + identical( $_[0], $f1, 'followed_by block passed $f1' ); + return $_[0]; + } ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + # Two refs; one in lexical $f1, one in $fseq's cancellation closure + is_refcount( $f1, 2, '$f1 has refcount 2 initially' ); + + is( $called, 0, '$called before $f1 done' ); + + $f1->done( results => "here" ); + + is( $called, 1, '$called after $f1 done' ); + + ok( $fseq->is_ready, '$fseq is done after $f1 done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); + + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); + is_oneref( $f1, '$f1 has refcount 1 before EOF' ); +} + +{ + my $f1 = Future->new; + + my $called = 0; + my $fseq = $f1->followed_by( sub { + $called++; + identical( $_[0], $f1, 'followed_by block passed $f1' ); + return $_[0]; + } ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + is( $called, 0, '$called before $f1 done' ); + + $f1->fail( "failure\n" ); + + is( $called, 1, '$called after $f1 failed' ); + + ok( $fseq->is_ready, '$fseq is ready after $f1 failed' ); + is_deeply( [ $fseq->failure ], [ "failure\n" ], '$fseq->get returns failure' ); + + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $fseq = $f1->followed_by( sub { + die "It fails\n"; + } ); + + ok( !defined exception { $f1->done }, 'exception not propagated from code call' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); +} + +# Cancellation +{ + my $f1 = Future->new; + + my $fseq = $f1->followed_by( + sub { die "followed_by of cancelled Future should not be invoked" } + ); + + $fseq->cancel; + + ok( $f1->is_cancelled, '$f1 cancelled by $fseq->cancel' ); + + $f1 = Future->new; + my $f2 = Future->new; + + $fseq = $f1->followed_by( sub { $f2 } ); + + $f1->done; + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel' ); + + $f1 = Future->done; + $f2 = Future->new; + + $fseq = $f1->followed_by( sub { $f2 } ); + + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel on $f1 immediate' ); +} + +# immediately done +{ + my $f1 = Future->done; + + my $called = 0; + my $fseq = $f1->followed_by( + sub { $called++; return $_[0] } + ); + + is( $called, 1, 'followed_by block invoked immediately for already-done' ); +} + +# immediately done +{ + my $f1 = Future->fail("Failure\n"); + + my $called = 0; + my $fseq = $f1->followed_by( + sub { $called++; return $_[0] } + ); + + is( $called, 1, 'followed_by block invoked immediately for already-failed' ); +} + +# immediately code dies +{ + my $f1 = Future->done; + + my $fseq; + + ok( !defined exception { + $fseq = $f1->followed_by( sub { + die "It fails\n"; + } ); + }, 'exception not propagated from ->followed_by on immediate' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception on immediate' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception on immediate' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->followed_by( + sub { Future->new } + ); + + like( $warnings, + qr/^Calling ->followed_by in void context at /, + 'Warning in void context' ); +} + +# Non-Future return raises exception +{ + my $f1 = Future->new; + + my $file = __FILE__; + my $line = __LINE__+1; + my $fseq = $f1->followed_by( sub {} ); + my $fseq2 = $f1->followed_by( sub { Future->done } ); + + ok( !exception { $f1->done }, + '->done with non-Future return from ->followed_by does not die' ); + + like( $fseq->failure, + qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, + 'Failure from non-Future return from ->followed_by' ); + + ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); + + my $fseq3; + ok( !exception { $fseq3 = $f1->followed_by( sub {} ) }, + 'non-Future return from ->followed_by on immediate does not die' ); + + like( $fseq3->failure, + qr/^Expected __ANON__\(.*\) to return a Future/, + 'Failure from non-Future return from ->followed_by on immediate' ); +} + +done_testing; diff --git a/t/09transform.t b/t/09transform.t new file mode 100644 index 0000000..67f7e25 --- /dev/null +++ b/t/09transform.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; + +# Result transformation +{ + my $f1 = Future->new; + + my $future = $f1->transform( + done => sub { result => @_ }, + ); + + $f1->done( 1, 2, 3 ); + + is_deeply( [ $future->get ], [ result => 1, 2, 3 ], '->transform result' ); +} + +# Failure transformation +{ + my $f1 = Future->new; + + my $future = $f1->transform( + fail => sub { "failure\n" => @_ }, + ); + + $f1->fail( "something failed\n" ); + + is_deeply( [ $future->failure ], [ "failure\n" => "something failed\n" ], '->transform failure' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $future = $f1->transform( + done => sub { die "It fails\n" }, + ); + + $f1->done; + + is_deeply( [ $future->failure ], [ "It fails\n" ], '->transform catches exceptions' ); +} + +# Cancellation +{ + my $f1 = Future->new; + + my $cancelled; + $f1->on_cancel( sub { $cancelled++ } ); + + my $future = $f1->transform; + + $future->cancel; + is( $cancelled, 1, '->transform cancel' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->transform( + done => sub { } + ); + like( $warnings, + qr/^Calling ->transform in void context at /, + 'Warning in void context' ); +} + +done_testing; diff --git a/t/10wait_all.t b/t/10wait_all.t new file mode 100644 index 0000000..9331b61 --- /dev/null +++ b/t/10wait_all.t @@ -0,0 +1,160 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use Test::Refcount; + +use Future; + +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_all( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->wait_all' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->wait_all' ); + + is_deeply( [ $future->pending_futures ], + [ $f1, $f2 ], + '$future->pending_futures before any ready' ); + + is_deeply( [ $future->ready_futures ], + [], + '$future->done_futures before any ready' ); + + my @on_ready_args; + $future->on_ready( sub { @on_ready_args = @_ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + is( scalar @on_ready_args, 0, 'on_ready not yet invoked' ); + + $f1->done( one => 1 ); + + is_deeply( [ $future->pending_futures ], + [ $f2 ], + '$future->pending_futures after $f1 ready' ); + + is_deeply( [ $future->ready_futures ], + [ $f1 ], + '$future->ready_futures after $f1 ready' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '$future->done_futures after $f1 ready' ); + + ok( !$future->is_ready, '$future still not yet ready after f1 ready' ); + is( scalar @on_ready_args, 0, 'on_ready not yet invoked' ); + + $f2->done( two => 2 ); + + is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' ); + identical( $on_ready_args[0], $future, 'Future passed to on_ready' ); + undef @on_ready_args; + + ok( $future->is_ready, '$future now ready after f2 ready' ); + my @results = $future->get; + identical( $results[0], $f1, 'Results[0] from $future->get is f1' ); + identical( $results[1], $f2, 'Results[1] from $future->get is f2' ); + undef @results; + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f2 ready' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f2 ready' ); + + is_deeply( [ $future->done_futures ], + [ $f1, $f2 ], + '$future->done_futures after $f2 ready' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); +} + +# immediately done +{ + my $f1 = Future->done; + + my $future = Future->wait_all( $f1 ); + + ok( $future->is_ready, '$future of already-ready sub already ready' ); + my @results = $future->get; + identical( $results[0], $f1, 'Results from $future->get of already ready' ); +} + +# one immediately done +{ + my $f1 = Future->done; + my $f2 = Future->new; + + my $future = Future->wait_all( $f1, $f2 ); + + ok( !$future->is_ready, '$future of partially-done subs not yet ready' ); + + $f2->done; + + ok( $future->is_ready, '$future of completely-done subs already ready' ); + my @results = $future->get; + identical( $results[0], $f1, 'Results from $future->get of already ready' ); +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->wait_all( $f1, $f2 ); + + $f2->done; + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); + is( $c2, undef, '$future->cancel ignores ready subs' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_all( $f1, $f2 ); + + $f1->done( "result" ); + $f2->cancel; + + ok( $future->is_ready, '$future of cancelled sub is ready after final cancellation' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '->done_futures with cancellation' ); + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '->cancelled_futures with cancellation' ); +} + +# wait_all on none +{ + my $f = Future->wait_all( () ); + + ok( $f->is_ready, 'wait_all on no Futures already done' ); + is_deeply( [ $f->get ], [], '->get on empty wait_all is empty' ); +} + +done_testing; diff --git a/t/11wait_any.t b/t/11wait_any.t new file mode 100644 index 0000000..c72629e --- /dev/null +++ b/t/11wait_any.t @@ -0,0 +1,152 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; +use Test::Refcount; + +use Future; + +# First done +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_any( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->wait_any' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->wait_any' ); + + is_deeply( [ $future->pending_futures ], + [ $f1, $f2 ], + '$future->pending_futures before any ready' ); + + is_deeply( [ $future->ready_futures ], + [], + '$future->done_futures before any ready' ); + + my @on_ready_args; + $future->on_ready( sub { @on_ready_args = @_ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + is( scalar @on_ready_args, 0, 'on_ready not yet invoked' ); + + $f1->done( one => 1 ); + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f1 ready' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f1 ready' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '$future->done_futures after $f1 ready' ); + + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '$future->cancelled_futures after $f1 ready' ); + + is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' ); + identical( $on_ready_args[0], $future, 'Future passed to on_ready' ); + undef @on_ready_args; + + ok( $future->is_ready, '$future now ready after f1 ready' ); + is_deeply( [ $future->get ], [ one => 1 ], 'results from $future->get' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); +} + +# First fails +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_any( $f1, $f2 ); + + $f1->fail( "It fails\n" ); + + ok( $future->is_ready, '$future now ready after a failure' ); + + is( $future->failure, "It fails\n", '$future->failure yields exception' ); + + is( exception { $future->get }, "It fails\n", '$future->get throws exception' ); + + ok( $f2->is_cancelled, '$f2 cancelled after a failure' ); +} + +# immediately done +{ + my $f1 = Future->done; + + my $future = Future->wait_any( $f1 ); + + ok( $future->is_ready, '$future of already-ready sub already ready' ); +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $future = Future->wait_all( $f1 ); + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_any( $f1, $f2 ); + + $f1->cancel; + + ok( !$future->is_ready, '$future not yet ready after first cancellation' ); + + $f2->done( "result" ); + + ok( $future->is_ready, '$future is ready' ); + + is_deeply( [ $future->done_futures ], + [ $f2 ], + '->done_futures with cancellation' ); + is_deeply( [ $future->cancelled_futures ], + [ $f1 ], + '->cancelled_futures with cancellation' ); + + my $f3 = Future->new; + $future = Future->wait_any( $f3 ); + + $f3->cancel; + + ok( $future->is_ready, '$future is ready after final cancellation' ); + + like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' ); +} + +# wait_any on none +{ + my $f = Future->wait_any( () ); + + ok( $f->is_ready, 'wait_any on no Futures already done' ); + is( scalar $f->failure, "Cannot ->wait_any with no subfutures", + '->get on empty wait_any is empty' ); +} + +done_testing; diff --git a/t/12needs_all.t b/t/12needs_all.t new file mode 100644 index 0000000..fe9cd36 --- /dev/null +++ b/t/12needs_all.t @@ -0,0 +1,147 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; + +use Future; + +# All done +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_all( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->needs_all' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->needs_all' ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->done( one => 1 ); + $f2->done( two => 2 ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f2 ready' ); + is_deeply( [ $future->get ], [ one => 1, two => 2 ], '$future->get after f2 ready' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); +} + +# One fails +{ + my $f1 = Future->new; + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_all( $f1, $f2 ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->fail( "It fails" ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f1 fails' ); + is( $future->failure, "It fails", '$future->failure yields exception' ); + my $file = __FILE__; + my $line = __LINE__ + 1; + like( exception { $future->get }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->get throws exception' ); + + is( $c2, 1, 'Unfinished child future cancelled on failure' ); + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f1 failure' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f1 failure' ); + + is_deeply( [ $future->done_futures ], + [], + '$future->done_futures after $f1 failure' ); + + is_deeply( [ $future->failed_futures ], + [ $f1 ], + '$future->failed_futures after $f1 failure' ); + + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '$future->cancelled_futures after $f1 failure' ); +} + +# immediately done +{ + my $future = Future->needs_all( Future->done ); + + ok( $future->is_ready, '$future of already-done sub already ready' ); +} + +# immediately fails +{ + my $future = Future->needs_all( Future->fail("F1"), Future->done ); + + ok( $future->is_ready, '$future of already-failed sub already ready' ); +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_all( $f1, $f2 ); + + $f2->done; + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); + is( $c2, undef, '$future->cancel ignores ready subs' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_all( $f1, $f2 ); + + $f1->cancel; + + ok( $future->is_ready, '$future of cancelled sub is ready after first cancellation' ); + + like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' ); +} + +# needs_all on none +{ + my $f = Future->needs_all( () ); + + ok( $f->is_ready, 'needs_all on no Futures already done' ); + is_deeply( [ $f->get ], [], '->get on empty needs_all is empty' ); +} + +done_testing; diff --git a/t/13needs_any.t b/t/13needs_any.t new file mode 100644 index 0000000..b94a762 --- /dev/null +++ b/t/13needs_any.t @@ -0,0 +1,200 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; + +use Future; + +# One done +{ + my $f1 = Future->new; + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_any( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->needs_any' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->needs_any' ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->done( one => 1 ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f1 ready' ); + is_deeply( [ $future->get ], [ one => 1 ], 'results from $future->get' ); + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f1 done' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f1 done' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '$future->done_futures after $f1 done' ); + + is_deeply( [ $future->failed_futures ], + [], + '$future->failed_futures after $f1 done' ); + + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '$future->cancelled_futures after $f1 done' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); + + is( $c2, 1, 'Unfinished child future cancelled on failure' ); +} + +# One fails +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_any( $f1, $f2 ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->fail( "Partly fails" ); + + ok( !$future->is_ready, '$future not yet ready after $f1 fails' ); + + $f2->done( two => 2 ); + + ok( $future->is_ready, '$future now ready after $f2 done' ); + is_deeply( [ $future->get ], [ two => 2 ], '$future->get after $f2 done' ); + + is_deeply( [ $future->done_futures ], + [ $f2 ], + '$future->done_futures after $f2 done' ); + + is_deeply( [ $future->failed_futures ], + [ $f1 ], + '$future->failed_futures after $f2 done' ); +} + +# All fail +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_any( $f1, $f2 ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->fail( "Partly fails" ); + + $f2->fail( "It fails" ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f2 fails' ); + is( $future->failure, "It fails", '$future->failure yields exception' ); + my $file = __FILE__; + my $line = __LINE__ + 1; + like( exception { $future->get }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->get throws exception' ); + + is_deeply( [ $future->failed_futures ], + [ $f1, $f2 ], + '$future->failed_futures after all fail' ); +} + +# immediately done +{ + my $future = Future->needs_any( Future->fail("F1"), Future->done ); + + ok( $future->is_ready, '$future of already-done sub already ready' ); +} + +# immediately fails +{ + my $future = Future->needs_any( Future->fail("F1") ); + + ok( $future->is_ready, '$future of already-failed sub already ready' ); + $future->failure; +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_all( $f1, $f2 ); + + $f2->fail( "booo" ); + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); + is( $c2, undef, '$future->cancel ignores ready subs' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_any( $f1, $f2 ); + + $f1->cancel; + + ok( !$future->is_ready, '$future not yet ready after first cancellation' ); + + $f2->done( "result" ); + + is_deeply( [ $future->done_futures ], + [ $f2 ], + '->done_futures with cancellation' ); + is_deeply( [ $future->cancelled_futures ], + [ $f1 ], + '->cancelled_futures with cancellation' ); + + my $f3 = Future->new; + $future = Future->needs_any( $f3 ); + + $f3->cancel; + + ok( $future->is_ready, '$future is ready after final cancellation' ); + + like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' ); +} + +# needs_any on none +{ + my $f = Future->needs_any( () ); + + ok( $f->is_ready, 'needs_any on no Futures already done' ); + is( scalar $f->failure, "Cannot ->needs_any with no subfutures", + '->get on empty needs_any is empty' ); +} + +done_testing; diff --git a/t/20subclass.t b/t/20subclass.t new file mode 100644 index 0000000..9d7103d --- /dev/null +++ b/t/20subclass.t @@ -0,0 +1,138 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +# subclass->... +{ + my $f = t::Future::Subclass->new; + my @seq; + + isa_ok( $seq[@seq] = $f->then( sub {} ), + "t::Future::Subclass", + '$f->then' ); + + isa_ok( $seq[@seq] = $f->else( sub {} ), + "t::Future::Subclass", + '$f->and_then' ); + + isa_ok( $seq[@seq] = $f->then_with_f( sub {} ), + "t::Future::Subclass", + '$f->then_with_f' ); + + isa_ok( $seq[@seq] = $f->else_with_f( sub {} ), + "t::Future::Subclass", + '$f->else_with_f' ); + + isa_ok( $seq[@seq] = $f->followed_by( sub {} ), + "t::Future::Subclass", + '$f->followed_by' ); + + isa_ok( $seq[@seq] = $f->transform(), + "t::Future::Subclass", + '$f->transform' ); + + $_->cancel for @seq; +} + +# immediate->followed_by( sub { subclass } ) +{ + my $f = t::Future::Subclass->new; + my $seq; + + isa_ok( $seq = Future->done->followed_by( sub { $f } ), + "t::Future::Subclass", + 'imm->followed_by $f' ); + + $seq->cancel; +} + +# convergents +{ + my $f = t::Future::Subclass->new; + my @seq; + + isa_ok( $seq[@seq] = Future->wait_all( $f ), + "t::Future::Subclass", + 'Future->wait_all( $f )' ); + + isa_ok( $seq[@seq] = Future->wait_any( $f ), + "t::Future::Subclass", + 'Future->wait_any( $f )' ); + + isa_ok( $seq[@seq] = Future->needs_all( $f ), + "t::Future::Subclass", + 'Future->needs_all( $f )' ); + + isa_ok( $seq[@seq] = Future->needs_any( $f ), + "t::Future::Subclass", + 'Future->needs_any( $f )' ); + + my $imm = Future->done; + + isa_ok( $seq[@seq] = Future->wait_all( $imm, $f ), + "t::Future::Subclass", + 'Future->wait_all( $imm, $f )' ); + + # Pick the more derived subclass even if all are pending + + isa_ok( $seq[@seq] = Future->wait_all( Future->new, $f ), + "t::Future::Subclass", + 'Future->wait_all( Future->new, $f' ); + + $_->cancel for @seq; +} + +# empty convergents (RT97537) +{ + my $f; + + isa_ok( $f = t::Future::Subclass->wait_all(), + "t::Future::Subclass", + 'subclass ->wait_all' ); + + isa_ok( $f = t::Future::Subclass->wait_any(), + "t::Future::Subclass", + 'subclass ->wait_any' ); + $f->failure; + + isa_ok( $f = t::Future::Subclass->needs_all(), + "t::Future::Subclass", + 'subclass ->needs_all' ); + + isa_ok( $f = t::Future::Subclass->needs_any(), + "t::Future::Subclass", + 'subclass ->needs_any' ); + $f->failure; +} + +my $f_await; +{ + my $f = t::Future::Subclass->new; + + my $count = 0; + $f_await = sub { + $count++; + identical( $_[0], $f, '->await is called on $f' ); + $_[0]->done( "Result here" ) if $count == 2; + }; + + is_deeply( [ $f->get ], + [ "Result here" ], + 'Result from ->get' ); + + is( $count, 2, '$f->await called twice' ); +} + +done_testing; + +package t::Future::Subclass; +use base qw( Future ); + +sub await +{ + $f_await->( @_ ); +} diff --git a/t/21debug.t b/t/21debug.t new file mode 100644 index 0000000..8ad5508 --- /dev/null +++ b/t/21debug.t @@ -0,0 +1,83 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +BEGIN { + $ENV{PERL_FUTURE_DEBUG} = 1; +} + +use Future; + +use Time::HiRes qw( gettimeofday tv_interval ); + +my $LINE; +my $LOSTLINE; + +sub warnings(&) +{ + my $code = shift; + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= shift }; + $code->(); + $LOSTLINE = __LINE__; return $warnings; +} + +is( warnings { + my $f = Future->new; + $f->done; + }, "", 'Completed Future does not give warning' ); + +is( warnings { + my $f = Future->new; + $f->cancel; + }, "", 'Cancelled Future does not give warning' ); + +like( warnings { + $LINE = __LINE__; my $f = Future->new; + undef $f; + }, + qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) before it was ready\.?$/, + 'Lost Future raises a warning' ); + +my $THENLINE; +my $SEQLINE; +like( warnings { + $LINE = __LINE__; my $f1 = Future->new; + $THENLINE = __LINE__; my $fseq = $f1->then( sub { } ); undef $fseq; + $SEQLINE = __LINE__; $f1->done; + }, + qr/^Future=\S+ was constructed at \Q$0\E line $THENLINE and was lost near \Q$0\E line (?:$SEQLINE|$THENLINE) before it was ready\.? +Future=\S+ \(constructed at \Q$0\E line $LINE\) lost a sequence Future at \Q$0\E line $SEQLINE\.?$/, + 'Lost sequence Future raises warning' ); + +like( warnings { + $LINE = __LINE__; my $f = Future->fail("Failed!"); + undef $f; + }, + qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) with an unreported failure of: Failed!\.?/, + 'Destroyed failed future raises warning' ); + +{ + local $Future::TIMES = 1; + + my $before = [ gettimeofday ]; + + my $future = Future->new; + + ok( defined $future->btime, '$future has btime with $TIMES=1' ); + ok( tv_interval( $before, $future->btime ) >= 0, '$future btime is not earlier than $before' ); + + $future->done; + + ok( defined $future->rtime, '$future has rtime with $TIMES=1' ); + ok( tv_interval( $future->btime, $future->rtime ) >= 0, '$future rtime is not earlier than btime' ); + ok( tv_interval( $future->rtime ) >= 0, '$future rtime is not later than now' ); + + ok( defined $future->elapsed, '$future has ->elapsed time' ); + ok( $future->elapsed >= 0, '$future elapsed time >= 0' ); +} + +done_testing; diff --git a/t/22wrap_cb.t b/t/22wrap_cb.t new file mode 100644 index 0000000..cdd6a59 --- /dev/null +++ b/t/22wrap_cb.t @@ -0,0 +1,105 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; + +our $VAR = ""; +# around Future::wrap_cb => sub { ... } +{ + my $orig = Future->can( 'wrap_cb' ); + no warnings 'redefine'; + *Future::wrap_cb = sub { + my $cb = $orig->(@_); + my $saved_VAR = $VAR; + + return sub { + local $VAR = $saved_VAR; + $cb->(@_); + }; + }; +} + +# on_ready +{ + my $result; + my $f = Future->new; + + { + local $VAR = "inner"; + $f->on_ready( sub { $result = $VAR } ); + } + + $f->done; + + is( $result, "inner", 'on_ready wraps CB' ); +} + +# on_done +{ + my $result; + my $f = Future->new; + + { + local $VAR = "inner"; + $f->on_done( sub { $result = $VAR } ); + } + + $f->done; + + is( $result, "inner", 'on_done wraps CB' ); +} + +# on_fail +{ + my $result; + my $f = Future->new; + + { + local $VAR = "inner"; + $f->on_fail( sub { $result = $VAR } ); + } + + $f->fail( "Failed" ); + + is( $result, "inner", 'on_fail wraps CB' ); +} + +# then +{ + my $result; + my $f = Future->new; + + my $f2; + { + local $VAR = "inner"; + $f2 = $f->then( sub { $result = $VAR; Future->done } ); + } + + $f->done; + + is( $result, "inner", 'then wraps CB' ); +} + +# else +{ + my $result; + my $f = Future->new; + + my $f2; + { + local $VAR = "inner"; + $f2 = $f->else( sub { $result = $VAR; Future->done } ); + } + + $f->fail( "Failed" ); + + is( $result, "inner", 'else wraps CB' ); +} + +# Other sequence methods all use the same ->_sequence so all should be fine + +done_testing; diff --git a/t/30utils-call.t b/t/30utils-call.t new file mode 100644 index 0000000..221d302 --- /dev/null +++ b/t/30utils-call.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +use Future; +use Future::Utils qw( call ); + +# call returns future +{ + my $ret_f; + my $f = call { + return $ret_f = Future->new; + }; + + identical( $f, $ret_f, 'call() returns future returned from its code' ); + $f->cancel; +} + +# call returns immediate failure on die +{ + my $f = call { + die "argh!\n"; + }; + + ok( $f->is_ready, 'call() returns immediate future on die' ); + is( scalar $f->failure, "argh!\n", 'failure from immediate future on die' ); +} + +# call returns immediate failure on non-Future return +{ + my $f = call { + return "non-future"; + }; + + ok( $f->is_ready, 'call() returns immediate future on non-future return' ); + like( scalar $f->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, + 'failure from immediate future on non-future return' ); +} + +done_testing; diff --git a/t/31utils-call-with-escape.t b/t/31utils-call-with-escape.t new file mode 100644 index 0000000..973900c --- /dev/null +++ b/t/31utils-call-with-escape.t @@ -0,0 +1,70 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; + +use Future; +use Future::Utils qw( call_with_escape ); + +# call_with_escape normal return +{ + my $ret_f; + my $f = call_with_escape { + return $ret_f = Future->new; + }; + + $ret_f->done( "result" ); + + ok( $f->is_ready, 'call_with_escape ready after returned future ready' ); + is( scalar $f->get, "result", 'result of call_with_escape' ); + + $f = call_with_escape { + return $ret_f = Future->new; + }; + + $ret_f->fail( "failure" ); + + ok( $f->is_ready, 'call_with_escape ready after returned future ready' ); + is( scalar $f->failure, "failure", 'result of call_with_escape' ); + + undef $ret_f; + is_oneref( $f, 'call_with_escape has refcount 1 before EOF' ); +} + +# call_with_escape synchronous escape +{ + my $f = call_with_escape { + my $escape = shift; + $escape->done( "escaped" ); + }; + + ok( $f->is_ready, 'call_with_escape ready after synchronous escape' ); + is( scalar $f->get, "escaped", 'result of call_with_escape' ); +} + +# call_with_escape delayed escape +{ + my $ret_f = Future->new; + my $inner_f; + + my $f = call_with_escape { + my $escape = shift; + return $inner_f = $ret_f->then( sub { + return $escape->done( "later escape" ); + }); + }; + + ok( !$f->is_ready, 'call_with_escape not yet ready before deferral' ); + + $ret_f->done; + + ok( $f->is_ready, 'call_with_escape ready after deferral' ); + is( scalar $f->get, "later escape", 'result of call_with_escape' ); + + ok( $inner_f->is_cancelled, 'code-returned future cancelled after escape' ); +} + +done_testing; diff --git a/t/32utils-repeat.t b/t/32utils-repeat.t new file mode 100644 index 0000000..4ee03ce --- /dev/null +++ b/t/32utils-repeat.t @@ -0,0 +1,188 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +use Future; +use Future::Utils qw( repeat try_repeat try_repeat_until_success ); + +{ + my $trial_f; + my $previous_trial; + my $arg; + my $again; + my $future = repeat { + $previous_trial = shift; + return $trial_f = Future->new + } while => sub { $arg = shift; $again }; + + ok( defined $future, '$future defined for repeat while' ); + + ok( defined $trial_f, 'An initial future is running' ); + + my $first_f = $trial_f; + + $again = 1; + $trial_f->done( "one" ); + + ok( defined $arg, '$arg defined for while test' ); + is( scalar $arg->get, "one", '$arg->get for first' ); + + identical( $previous_trial, $first_f, 'code block is passed previous trial' ); + + $again = 0; + $trial_f->done( "two" ); + + ok( $future->is_ready, '$future is now ready after second attempt ->done' ); + is( scalar $future->get, "two", '$future->get' ); +} + +# return keyword +{ + my $trial_f; + my $future = repeat { + return $trial_f = Future->new + } while => sub { 1 }, return => my $ret = Future->new; + + identical( $future, $ret, 'repeat with return yields correct instance' ); +} + +# cancellation +{ + my @running; my $i = 0; + my $future = repeat { + return $running[$i++] = Future->new + } while => sub { 1 }; + + ok( defined $future, '$future defined for repeat while' ); + + ok( defined $running[0], 'An initial future is running' ); + + $running[0]->done; + + $future->cancel; + + ok( !$running[0]->is_cancelled, 'previously running future not cancelled' ); + ok( $running[1]->is_cancelled, 'running future cancelled after eventual is cancelled' ); + ok( !$running[2], 'a third trial is not started' ); +} + +# until +{ + my $trial_f; + my $arg; + my $accept; + my $future = repeat { + return $trial_f = Future->new + } until => sub { $arg = shift; $accept }; + + ok( defined $future, '$future defined for repeat until' ); + + ok( defined $trial_f, 'An initial future is running' ); + + $accept = 0; + $trial_f->done( "three" ); + + ok( defined $arg, '$arg defined for while test' ); + is( scalar $arg->get, "three", '$arg->get for first' ); + + $accept = 1; + $trial_f->done( "four" ); + + ok( $future->is_ready, '$future is now ready after second attempt ->done' ); + is( scalar $future->get, "four", '$future->get' ); +} + +# body code dies +{ + my $future; + + $future = repeat { + die "It failed\n"; + } while => sub { !shift->failure }; + + is( $future->failure, "It failed\n", 'repeat while failure after code exception' ); + + $future = repeat { + die "It failed\n"; + } until => sub { shift->failure }; + + is( $future->failure, "It failed\n", 'repeat until failure after code exception' ); +} + +# condition code dies (RT100067) +{ + my $future = repeat { + Future->done(1); + } while => sub { die "it dies!\n" }; + + is( $future->failure, "it dies!\n", 'repeat while failure after condition exception' ); +} + +# Non-Future return fails +{ + my $future; + + $future = repeat { + "non-Future" + } while => sub { !shift->failure }; + + like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, + 'repeat failure for non-Future return' ); +} + +# try_repeat catches failures +{ + my $attempt = 0; + my $future = try_repeat { + if( ++$attempt < 3 ) { + return FUture->new->fail( "Too low" ); + } + else { + return Future->done( $attempt ); + } + } while => sub { shift->failure }; + + ok( $future->is_ready, '$future is now ready for try_repeat' ); + is( scalar $future->get, 3, '$future->get' ); +} + +{ + my $attempt = 0; + my $future = try_repeat_until_success { + if( ++$attempt < 3 ) { + return Future->fail( "Too low" ); + } + else { + return Future->done( $attempt ); + } + }; + + ok( $future->is_ready, '$future is now ready for try_repeat_until_success' ); + is( scalar $future->get, 3, '$future->get' ); +} + +# repeat prints a warning if asked to retry a failure +{ + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= join "", @_ }; + + my $attempt = 0; + my $future = repeat { + if( ++$attempt < 3 ) { + return Future->fail( "try again" ); + } + else { + return Future->done( "OK" ); + } + } while => sub { $_[0]->failure }; + + ok( $future->is_ready, '$future is now ready after repeat retries failures' ); + like( $warnings, qr/(?:^Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead at \Q$0\E line \d+\.?$)+/m, + 'Warnings printing by repeat retries failures' ); +} + +done_testing; diff --git a/t/33utils-repeat-generate.t b/t/33utils-repeat-generate.t new file mode 100644 index 0000000..72410fb --- /dev/null +++ b/t/33utils-repeat-generate.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; +use Future::Utils qw( repeat ); + +# generate without otherwise +{ + my $trial_f; + my $arg; + + my $i = 0; + my $future = repeat { + $arg = shift; + return $trial_f = Future->new; + } generate => sub { $i < 3 ? ++$i : () }; + + is( $arg, 1, '$arg 1 for first iteration' ); + $trial_f->done; + + ok( !$future->is_ready, '$future not ready' ); + + is( $arg, 2, '$arg 2 for second iteratoin' ); + $trial_f->done( "not yet" ); + + ok( !$future->is_ready, '$future still not ready' ); + + is( $arg, 3, '$arg 3 for third iteration' ); + $trial_f->done( "result" ); + + ok( $future->is_ready, '$future now ready' ); + is( scalar $future->get, "result", '$future->get' ); +} + +# generate otherwise +{ + my $last_trial_f; + my $i = 0; + my $future = repeat { + Future->done( "ignore me $_[0]" ); + } generate => sub { $i < 3 ? ++$i : () }, + otherwise => sub { + $last_trial_f = shift; + return Future->fail( "Nothing succeeded\n" ); + }; + + is( scalar $future->failure, "Nothing succeeded\n", '$future returns otherwise failure' ); + is( scalar $last_trial_f->get, "ignore me 3", '$last_trial_f->get' ); + + $future = repeat { + Future->done( "ignore me" ); + } generate => sub { () }, + otherwise => sub { Future->fail( "Nothing to do\n" ) }; + + is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty generator' ); +} + +# Probably don't need much more testing since most combinations are test with +# foreach - while/until, die, etc.. + +done_testing; diff --git a/t/34utils-repeat-foreach.t b/t/34utils-repeat-foreach.t new file mode 100644 index 0000000..94d70d6 --- /dev/null +++ b/t/34utils-repeat-foreach.t @@ -0,0 +1,152 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; +use Future::Utils qw( repeat try_repeat try_repeat_until_success ); + +# foreach without otherwise +{ + my $trial_f; + my $arg; + my $future = repeat { + $arg = shift; + return $trial_f = Future->new; + } foreach => [qw( one two three )]; + + is( $arg, "one", '$arg one for first iteration' ); + $trial_f->done; + + ok( !$future->is_ready, '$future not ready' ); + + is( $arg, "two", '$arg two for second iteration' ); + $trial_f->done( "another" ); + + ok( !$future->is_ready, '$future not ready' ); + + is( $arg, "three", '$arg three for third iteration' ); + $trial_f->done( "result" ); + + ok( $future->is_ready, '$future now ready' ); + is( scalar $future->get, "result", '$future->get' ); +} + +# foreach otherwise +{ + my $last_trial_f; + my $future = repeat { + Future->done( "ignore me $_[0]" ); + } foreach => [qw( one two three )], + otherwise => sub { + $last_trial_f = shift; + return Future->fail( "Nothing succeeded\n" ); + }; + + is( scalar $future->failure, "Nothing succeeded\n", '$future returns otherwise failure' ); + is( scalar $last_trial_f->get, "ignore me three", '$last_trial_f->get' ); + + $future = repeat { + Future->done( "ignore me" ); + } foreach => [], + otherwise => sub { Future->fail( "Nothing to do\n" ) }; + + is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty list' ); +} + +# foreach on empty list +{ + my $future = repeat { die "Not invoked" } foreach => []; + + ok( $future->is_ready, 'repeat {} on empty foreach without otherwise already ready' ); + is_deeply( [ $future->get ], [], 'Result of empty future' ); + + $future = repeat { die "Not invoked" } foreach => [], + otherwise => sub { Future->done( 1, 2, 3 ) }; + + ok( $future->is_ready, 'repeat {} on empty foreach with otherwise already ready' ); + is_deeply( [ $future->get ], [ 1, 2, 3 ], 'Result of otherwise future' ); +} + +# foreach while +{ + my $future = try_repeat { + my $arg = shift; + if( $arg eq "bad" ) { + return Future->fail( "bad" ); + } + else { + return Future->done( $arg ); + } + } foreach => [qw( bad good not-attempted )], + while => sub { shift->failure }; + + is( scalar $future->get, "good", '$future->get returns correct result for foreach+while' ); +} + +# foreach until +{ + my $future = try_repeat { + my $arg = shift; + if( $arg eq "bad" ) { + return Future->fail( "bad" ); + } + else { + return Future->done( $arg ); + } + } foreach => [qw( bad good not-attempted )], + until => sub { !shift->failure }; + + is( scalar $future->get, "good", '$future->get returns correct result for foreach+until' ); +} + +# foreach while + otherwise +{ + my $future = repeat { + Future->done( $_[0] ); + } foreach => [ 1, 2, 3 ], + while => sub { $_[0]->get < 2 }, + otherwise => sub { Future->fail( "Failed to find 2" ) }; + + is( scalar $future->get, 2, '$future->get returns successful result from while + otherwise' ); +} + +# try_repeat_until_success foreach +{ + my $future = try_repeat_until_success { + my $arg = shift; + if( $arg eq "bad" ) { + return Future->fail( "bad" ); + } + else { + return Future->done( $arg ); + } + } foreach => [qw( bad good not-attempted )]; + + is( scalar $future->get, "good", '$future->get returns correct result for try_repeat_until_success' ); +} + +# main code dies +{ + my $future = try_repeat { + $_[1]->failure if @_ > 1; # absorb the previous failure + + die "It failed\n"; + } foreach => [ 1, 2, 3 ]; + + is( $future->failure, "It failed\n", 'repeat foreach failure after code exception' ); +} + +# otherwise code dies +{ + my $future = repeat { + Future->done; + } foreach => [], + otherwise => sub { die "It failed finally\n" }; + + is( $future->failure, "It failed finally\n", 'repeat foreach failure after otherwise exception' ); +} + +done_testing; diff --git a/t/35utils-map-void.t b/t/35utils-map-void.t new file mode 100644 index 0000000..3f62e5f --- /dev/null +++ b/t/35utils-map-void.t @@ -0,0 +1,200 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +use Future; +use Future::Utils qw( fmap_void ); + +# fmap_void from ARRAY, no concurrency +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ]; + + ok( defined $future, '$future defined for fmap non-concurrent' ); + + ok( defined $subf[0], '$subf[0] defined' ); + ok( !defined $subf[1], '$subf[1] not yet defined' ); + + $subf[0]->done; + + ok( defined $subf[1], '$subf[1] defined after $subf[0] done' ); + + $subf[1]->done; + + $subf[2]->done; + + ok( $future->is_ready, '$future now ready after subs done' ); + is_deeply( [ $future->get ], [], '$future->get empty for fmap_void' ); +} + +# fmap_void from CODE +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new + } generate => do { my $count = 0; + sub { return unless $count < 3; $count++ } }; + + ok( defined $future, '$future defined for fmap non-concurrent from CODE' ); + + ok( defined $subf[0], '$subf[0] defined' ); + + $subf[0]->done; + $subf[1]->done; + $subf[2]->done; + + ok( $future->is_ready, '$future now ready after subs done from CODE' ); +} + +# fmap_void concurrent +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 4 ], + concurrent => 2; + + ok( defined $future, '$future defined for fmap concurrent=2' ); + + ok( defined $subf[0], '$subf[0] defined' ); + ok( defined $subf[1], '$subf[1] defined' ); + + $subf[0]->done; $subf[1]->done; + + ok( defined $subf[2], '$subf[2] defined' ); + ok( defined $subf[3], '$subf[3] defined' ); + + $subf[2]->done; $subf[3]->done; + + ok( defined $subf[4], '$subf[4] deifned' ); + ok( !$future->is_ready, '$future not yet ready while one sub remains' ); + + $subf[4]->done; + + ok( $future->is_ready, '$future now ready after concurrent subs done' ); +} + +# fmap_void late-addition concurrently +{ + my @items = ( 1, 2, 3 ); + my @subf; + my $future = fmap_void { + my $val = shift; + my $f = $subf[$val] = Future->new; + $f->on_done( sub { push @items, 4, 5, 6 } ) if $val == 3; + $f + } foreach => \@items, + concurrent => 4; + + ok( defined $future, '$future defined for fmap concurrent=3 late-add' ); + + ok( $subf[1] && $subf[2] && $subf[3], '3 subfutures initally ready' ); + + $subf[1]->done; + $subf[2]->done; + + ok( !$subf[4], 'No $subf[4] before $subf[3] done' ); + + $subf[3]->done; + + ok( $subf[4] && $subf[5] && $subf[6], '3 new subfutures now ready' ); + + $subf[4]->done; + $subf[5]->done; + $subf[6]->done; + + ok( $future->is_ready, '$future now ready after all 6 subfutures done' ); +} + +# fmap_void on immediates +{ + my $future = fmap_void { + return Future->done + } foreach => [ 0 .. 2 ]; + + ok( $future->is_ready, '$future already ready for fmap on immediates' ); +} + +# fmap_void on non/immediate mix +{ + my @item_f = ( my $item = Future->new, Future->done, Future->done ); + my $future = fmap_void { + return $_[0]; + } foreach => \@item_f, + concurrent => 2; + + ok( !$future->is_ready, '$future not yet ready before non-immediate done' ); + + $item->done; + ok( $future->is_ready, '$future now ready after non-immediate done' ); +} + +# fmap_void fail +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new; + } foreach => [ 0, 1, 2 ], + concurrent => 2; + + ok( !$subf[0]->is_cancelled, '$subf[0] not cancelled before failure' ); + + $subf[1]->fail( "failure" ); + + ok( $subf[0]->is_cancelled, '$subf[0] now cancelled after $subf[1] failure' ); + ok( $future->is_ready, '$future now ready after $sub[1] failure' ); + is( scalar $future->failure, "failure", '$future->failure after $sub[1] failure' ); + ok( !defined $subf[2], '$subf[2] was never started after $subf[1] failure' ); +} + +# fmap_void immediate fail +{ + my @subf; + my $future = fmap_void { + if( $_[0] eq "fail" ) { + return Future->fail( "failure" ); + } + else { + $subf[$_[0]] = Future->new; + } + } foreach => [ 0, "fail", 2 ], + concurrent => 3; + + ok( $future->is_ready, '$future is already ready' ); + is( scalar $future->failure, "failure", '$future->failure after immediate failure' ); + + ok( $subf[0]->is_cancelled, '$subf[0] is cancelled after immediate failure' ); + ok( !defined $subf[2], '$subf[2] was never started after immediate failure' ); +} + +# fmap_void cancel +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new; + } foreach => [ 0, 1, 2 ], + concurrent => 2; + + $future->cancel; + + ok( $subf[0]->is_cancelled, '$subf[0] now cancelled after ->cancel' ); + ok( $subf[1]->is_cancelled, '$subf[1] now cancelled after ->cancel' ); + ok( !defined $subf[2], '$subf[2] was never started after ->cancel' ); +} + +# fmap_void return +{ + my $future = fmap_void { + return Future->done; + } foreach => [ 0 ], return => my $ret = Future->new; + + identical( $future, $ret, 'repeat with return yields correct instance' ); +} + +done_testing; diff --git a/t/36utils-map.t b/t/36utils-map.t new file mode 100644 index 0000000..a19c43c --- /dev/null +++ b/t/36utils-map.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; +use Future::Utils qw( fmap_concat fmap_scalar ); + +# fmap_concat no concurrency +{ + my @subf; + my $future = fmap_concat { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ]; + + my @results; + $future->on_done( sub { @results = @_ }); + + $subf[0]->done( "A", "B" ); + $subf[1]->done( "C", "D", ); + $subf[2]->done( "E" ); + + ok( $future->is_ready, '$future now ready after subs done for fmap_concat' ); + is_deeply( [ $future->get ], [qw( A B C D E )], '$future->get for fmap_concat' ); + is_deeply( \@results, [qw( A B C D E )], '@results for fmap_concat' ); +} + +# fmap_concat concurrent +{ + my @subf; + my $future = fmap_concat { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ], + concurrent => 3; + + # complete out of order + $subf[0]->done( "A", "B" ); + $subf[2]->done( "E" ); + $subf[1]->done( "C", "D" ); + + is_deeply( [ $future->get ], [qw( A B C D E )], '$future->get for fmap_concat out of order' ); +} + +# fmap_scalar no concurrency +{ + my @subf; + my $future = fmap_scalar { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ]; + + my @results; + $future->on_done( sub { @results = @_ }); + + $subf[0]->done( "A" ); + $subf[1]->done( "B" ); + $subf[2]->done( "C" ); + + ok( $future->is_ready, '$future now ready after subs done for fmap_scalar' ); + is_deeply( [ $future->get ], [qw( A B C )], '$future->get for fmap_scalar' ); + is_deeply( \@results, [qw( A B C )], '@results for fmap_scalar' ); +} + +done_testing; diff --git a/t/50test-future.t b/t/50test-future.t new file mode 100644 index 0000000..326066e --- /dev/null +++ b/t/50test-future.t @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; +use Test::Builder::Tester; + +use Future; +use Test::Future; + +# pass +{ + test_out( "ok 1 - immediate Future" ); + + my $ran_code; + no_pending_futures { + $ran_code++; + Future->done(1,2,3); + } 'immediate Future'; + + test_test( "immediate Future passes" ); + ok( $ran_code, 'actually ran the code' ); +} + +# fail +{ + test_out( "not ok 1 - pending Future" ); + test_fail( +8 ); + test_err( "# The following Futures are still pending:" ); + test_err( qr/^# 0x[0-9a-f]+\n/ ); + test_err( qr/^# Writing heap dump to \S+\n/ ) if Test::Future::HAVE_DEVEL_MAT_DUMPER; + + my $f; + no_pending_futures { + $f = Future->new; + } 'pending Future'; + + test_test( "pending Future fails" ); + + $f->cancel; +} + +# does not retain Futures +{ + test_out( "ok 1 - refcount 2 before drop" ); + test_out( "ok 2 - refcount 1 after drop" ); + test_out( "ok 3 - retain" ); + + no_pending_futures { + my $arr = [1,2,3]; + my $f = Future->new; + $f->done( $arr ); + is_refcount( $arr, 2, 'refcount 2 before drop' ); + undef $f; + is_refcount( $arr, 1, 'refcount 1 after drop' ); + } 'retain'; + + test_test( "no_pending_futures does not retain completed Futures" ); +} + +# does not retain immedate Futures +{ + test_out( "ok 1 - refcount 2 before drop" ); + test_out( "ok 2 - refcount 1 after drop" ); + test_out( "ok 3 - retain" ); + + no_pending_futures { + my $arr = [1,2,3]; + my $f = Future->done( $arr ); + is_refcount( $arr, 2, 'refcount 2 before drop' ); + undef $f; + is_refcount( $arr, 1, 'refcount 1 after drop' ); + } 'retain'; + + test_test( "no_pending_futures does not retain immediate Futures" ); +} + +END { + # Clean up Devel::MAT dumpfile + my $pmat = $0; + $pmat =~ s/\.t$/-1.pmat/; + unlink $pmat if -f $pmat; +} + +done_testing; diff --git a/t/99pod.t b/t/99pod.t new file mode 100644 index 0000000..eb319fb --- /dev/null +++ b/t/99pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +all_pod_files_ok(); |