Future-0.48000755001750001750 014174113203 11434 5ustar00leoleo000000000000Future-0.48/Build.PL000444001750001750 534414174113203 13073 0ustar00leoleo000000000000use v5.10; 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', configure_requires => { 'Module::Build' => "0.4004", # test_requires }, requires => { 'Carp' => '1.25', # new message format with trailing period 'Test::Builder::Module' => 0, 'Time::HiRes' => 0, 'perl' => '5.010', # // }, test_requires => { 'Test::Identity' => 0, 'Test::Fatal' => 0, 'Test::More' => '0.88', # done_testing 'Test::Refcount' => 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 }}, }, auto_configure_requires => 0, # Don't add M::B license => 'perl', create_license => 1, create_readme => 1, meta_merge => { resources => { x_IRC => "irc://irc.perl.org/#io-async", }, }, ); $build->create_build_script; Future-0.48/Changes000444001750001750 3601314174113203 13107 0ustar00leoleo000000000000Revision history for Future 0.48 2022-01-26 [CHANGES] * Implement the new AWAIT_ON_CANCEL API shape for Future::AsyncAwait [BUGFIXES] * Make sure to set rtime for immediate futures (RT134620) 0.47 2021-01-01 [BUGFIXES] * Don't weaken() the waiting future in Future::Mutex as that causes it to be dropped in some situations 0.46 2020-10-19 [CHANGES] * Provide AWAIT_CHAIN_CANCEL named method for compatibility with upcoming Future::AsyncAwait::Awaitable method rename [BUGFIXES] * Ensure that Future::Mutex returns proper cloned future instances when waiting (RT133563) 0.45 2020-04-22 [CHANGES] * API changes to make duck-typing closer to Promises/A+ et.al: + Allow sequencing methods to yield non-Future results; upgrade them to being Future-wrapped + Add ->resolve and ->reject as aliases of ->done and ->fail * Recognise PERL_FUTURE_STRICT environment variable to restore previous sequencing method behaviour [BUGFIXES] * ->without_cancel still needs to cancel result if caller is cancelled * Ensure all Future::AsyncAwait interop methods properly respect subclassing 0.44 2020-03-25 [CHANGES] * Added ->result; use that in unit tests and docs where appropriate * Slight performance boost in internals by direct field access rather than accessor methods * Document ->await properly; make it wait until ready * Discourage ->block_until_ready 0.43 2020-01-07 [CHANGES] * Implement the Future::AsyncAwait::Awaitable API methods directly 0.42 2019-11-12 [CHANGES] * Added Future::Queue [BUGFIXES] * Remove already-completed futures from the on_cancel chain of others to avoid the list growing arbitrarily large in some situations; e.g easily provoked by long loops in Future::AsyncAwait 0.41 2019-06-13 [CHANGES] * Added Future::Exception->throw 0.40 2019-05-03 [CHANGES] * Added Future::Exception (RT129373) * Make ->get throw a Future::Exception and ->fail recognise one * Better documentation of the failure category parameter * Added a properly-documented ->block_until_ready 0.39 2018-09-20 14:03:05 [CHANGES] * Added Test::Future::Deferred * Use Syntax::Keyword::Try in example code * Various docs fixes 0.38 2017-12-18 01:41:52 [CHANGES] * Added counting ability to Future::Mutex (RT123876) [BUGFIXES] * Support perl 5.8.1 again (thanks ilmari) 0.37 2017/11/28 15:39:22 [CHANGES] * Finally got around to removing the old Makefile.PL [BUGFIXES] * Fix for convergent futures that lose strong references during cancellation (RT120468) * ->without_cancel shouldn't retain the originating future after completion (RT122920) 0.36 2017/11/27 22:04:52 [CHANGES] * Added ->retain method (RT123711) * Fixed some typoes in docs (RT118309) * Added ->state method (RT120759) [BUGFIXES] * Ensure that ->without_cancel still strongly holds a reference to its parent future (RT122920) 0.35 2017/06/23 20:37:57 [CHANGES] * Link to YAPC::EU talk video in SEE ALSO [BUGFIXES] * Handle cancelled/completed slots when fmap is cancelled (RT120469) (thanks tm604) 0.34 2016/10/02 18:40:06 [CHANGES] * Added Future::Mutex * Minor documentation wording fixes (thanks ilmari) [BUGFIXES] * Fallback to 'configure_requires' for older versions of Module::Build that don't support 'test_requires' (RT110721) 0.33 2015/07/29 16:15:55 [CHANGES] * Added ->catch and ->catch_with_f * Add catch-handler semantics to ->then / ->then_with_f * Also pass fmap* items via $_ (RT105558) * Undocument ->done_cb / ->fail_cb / ->cancel_cb * Entirely delete ->and_then / ->or_else * New barename documentation style including "since" versions * Further document the idea of failure categories as used by catch* 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. Future-0.48/LICENSE000444001750001750 4376214174113203 12632 0ustar00leoleo000000000000This software is copyright (c) 2022 by Paul Evans . 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) 2022 by Paul Evans . 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. Copyright (C) 19yy 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. , 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) 2022 by Paul Evans . 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 Future-0.48/MANIFEST000444001750001750 135614174113203 12727 0ustar00leoleo000000000000Build.PL Changes lib/Future.pm lib/Future/Exception.pm lib/Future/Mutex.pm lib/Future/Phrasebook.pod lib/Future/Queue.pm lib/Future/Utils.pm lib/Test/Future.pm lib/Test/Future/Deferred.pm LICENSE 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/07catch.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/23exception.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/40mutex.t t/41queue.t t/50test-future.t t/51test-future-deferred.t t/52awaitable-future.t t/99pod.t Future-0.48/META.json000444001750001750 357514174113203 13224 0ustar00leoleo000000000000{ "abstract" : "represent an operation awaiting completion", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4231", "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.010" } }, "test" : { "requires" : { "Test::Fatal" : "0", "Test::Identity" : "0", "Test::More" : "0.88", "Test::Refcount" : "0" } } }, "provides" : { "Future" : { "file" : "lib/Future.pm", "version" : "0.48" }, "Future::Exception" : { "file" : "lib/Future/Exception.pm", "version" : "0.48" }, "Future::Mutex" : { "file" : "lib/Future/Mutex.pm", "version" : "0.48" }, "Future::Queue" : { "file" : "lib/Future/Queue.pm", "version" : "0.48" }, "Future::Utils" : { "file" : "lib/Future/Utils.pm", "version" : "0.48" }, "Test::Future" : { "file" : "lib/Test/Future.pm", "version" : "0.48" }, "Test::Future::Deferred" : { "file" : "lib/Test/Future/Deferred.pm", "version" : "0.48" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "x_IRC" : "irc://irc.perl.org/#io-async" }, "version" : "0.48", "x_serialization_backend" : "JSON::PP version 4.06" } Future-0.48/META.yml000444001750001750 230014174113203 13035 0ustar00leoleo000000000000--- abstract: 'represent an operation awaiting completion' author: - 'Paul Evans ' 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.4231, CPAN::Meta::Converter version 2.150010' 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.48' Future::Exception: file: lib/Future/Exception.pm version: '0.48' Future::Mutex: file: lib/Future/Mutex.pm version: '0.48' Future::Queue: file: lib/Future/Queue.pm version: '0.48' Future::Utils: file: lib/Future/Utils.pm version: '0.48' Test::Future: file: lib/Test/Future.pm version: '0.48' Test::Future::Deferred: file: lib/Test/Future/Deferred.pm version: '0.48' requires: Carp: '1.25' Test::Builder::Module: '0' Time::HiRes: '0' perl: '5.010' resources: IRC: irc://irc.perl.org/#io-async license: http://dev.perl.org/licenses/ version: '0.48' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Future-0.48/README000444001750001750 13175514174113203 12525 0ustar00leoleo000000000000NAME 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. Unless otherwise noted, the following methods require at least version 0.08. FAILURE CATEGORIES While not directly required by Future or its related modules, a growing convention of Future-using code is to encode extra semantics in the arguments given to the fail method, to represent different kinds of failure. The convention is that after the initial message string as the first required argument (intended for display to humans), the second argument is a short lowercase string that relates in some way to the kind of failure that occurred. Following this is a list of details about that kind of failure, whose exact arrangement or structure are determined by the failure category. For example, IO::Async and Net::Async::HTTP use this convention to indicate at what stage a given HTTP request has failed: ->fail( $message, http => ... ) # an HTTP-level error during protocol ->fail( $message, connect => ... ) # a TCP-level failure to connect a # socket ->fail( $message, resolve => ... ) # a resolver (likely DNS) failure # to resolve a hostname By following this convention, a module remains consistent with other Future-based modules, and makes it easy for program logic to gracefully handle and manage failures by use of the catch method. 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 overrides the "await" method, this will be called by get and failure if the instance is still pending. 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; 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). Future::AsyncAwait::Awaitable ROLE Since version 0.43 this module provides the Future::AsyncAwait::Awaitable API. Subclass authors should note that several of the API methods are provided by special optimised internal methods, which may require overriding in your subclass if your internals are different from that of this module. CONSTRUCTORS new $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. done (class method) fail (class method) $future = Future->done( @values ) $future = Future->fail( $exception, $category, @details ) Since version 0.26. Shortcut wrappers around creating a new Future then immediately marking it as done or failed. wrap $future = Future->wrap( @values ) Since version 0.14. 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. call $future = Future->call( \&code, @args ) Since version 0.15. 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. METHODS As there are a lare number of methods on this class, they are documented here in several sections. INSPECTION METHODS The following methods query the internal state of a Future instance without modifying it or otherwise causing side-effects. is_ready $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. is_done $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. is_failed $failed = $future->is_failed Since version 0.26. Returns true on a future if it is ready and it failed. Returns false if it is still pending, completed successfully, or was cancelled. is_cancelled $cancelled = $future->is_cancelled Returns true if the future has been cancelled by cancel. state $str = $future->state Since version 0.36. Returns a string describing the state of the future, as one of the three states named above; namely done, failed or cancelled, or pending if it is none of these. IMPLEMENTATION METHODS These methods would primarily be used by implementations of asynchronous interfaces. done $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. Since version 0.45: this method is also available under the name resolve. fail $future->fail( $exception, $category, @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. A failure category name and other further details may be provided that will be returned by the failure method in list context. 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. If passed a Future::Exception instance (i.e. an object previously thrown by the get), the additional details will be preserved. This allows the additional details to be transparently preserved by such code as ... catch { return Future->fail($@); } Since version 0.45: this method is also available under the name reject. die $future->die( $message, $category, @details ) Since version 0.09. 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. on_cancel $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 the method is ignored. If the future is later cancelled, the callbacks will be invoked in the reverse order to that in which they were registered. $on_cancel->( $future ) If passed another Future instance, the passed instance will be cancelled when the original future is cancelled. In this case, the reference is only strongly held while the target future remains pending. If it becomes ready, then there is no point trying to cancel it, and so it is removed from the originating future's cancellation list. USER METHODS These methods would primarily be used by users of asynchronous interfaces, on objects returned by such an interface. on_ready $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 ) 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. Returns the $future. result @result = $future->result $result = $future->result Since version 0.44. 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 that was given to the fail method. If additional details were given to the fail method, an exception object is constructed to wrap them of type Future::Exception. If the future was cancelled or is not yet ready an exception is thrown. get @result = $future->get $result = $future->get If the future is ready, returns the result or throws the failure exception as per "result". If it is not yet ready then "await" is invoked to wait for a ready state, and the result returned as above. await $f = $f->await Since version 0.44. Blocks until the future instance is no longer pending. Returns the invocant future itself, so it is useful for chaining. Usually, calling code would either force the future using "get", or use either then chaining or async/await syntax to wait for results. This method is useful in cases where the exception-throwing part of get is not required, perhaps because other code will be testing the result using "is_done" or similar. if( $f->await->is_done ) { ... } This method is intended for subclasses to override. The default implementation will throw an exception if called on a still-pending instance. block_until_ready $f = $f->block_until_ready Since version 0.40. Now a synonym for "await". New code should invoke await directly. unwrap @values = Future->unwrap( @values ) Since version 0.26. 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 blocking wait, 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. on_done $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 ) If passed another Future instance, the passed instance will have its done method invoked when the original future completes successfully. Returns the $future. failure $exception = $future->failure $exception, $category, @details = $future->failure If the future is ready, returns the exception passed to the fail method or undef if the future completed successfully via the done method. If it is not yet ready then "await" is invoked to wait for a ready state. If called in list context, will additionally yield the category name and 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->result; ... } on_fail $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 other details passed to the fail method. $on_fail->( $exception, $category, @details ) 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( @_ ) } ); Returns the $future. cancel $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. 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. The invoked code could return a future, or a result directly. Since version 0.45: if a non-future result is returned it will be wrapped in a new immediate Future instance. This behaviour can be disabled by setting the PERL_FUTURE_STRICT environment variable to a true value at compiletime: $ PERL_FUTURE_STRICT=1 perl ... 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. Note that since the code is invoked in scalar context, you cannot directly return a list of values this way. Any list-valued results must be done by returning a Future instance. sub { ... return Future->done( @results ); } 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. then $future = $f1->then( \&done_code ) Since version 0.13. 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 ) else $future = $f1->else( \&fail_code ) Since version 0.13. 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 other 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, $category, @details ) then (2 arguments) $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 similar to those provided by other future systems, such as Javascript's Q or Promises/A libraries. catch $future = $f1->catch( name => \&code, name => \&code, ... ) Since version 0.33. Returns a new sequencing Future that behaves like an else call which dispatches to a choice of several alternative handling functions depending on the kind of failure that occurred. If $f1 fails with a category name (i.e. the second argument to the fail call) which exactly matches one of the string names given, then the corresponding code is invoked, being passed the same arguments as a plain else call would take, and is expected to return a Future in the same way. $f2 = $code->( $exception, $category, @details ) If $f1 does not fail, fails without a category name at all, or fails with a category name that does not match any given to the catch method, then the returned sequence future immediately completes with the same result, and no block of code is invoked. If passed an odd-sized list, the final argument gives a function to invoke on failure if no other handler matches. $future = $f1->catch( name => \&code, ... \&fail_code, ) This feature is currently still a work-in-progress. It currently can only cope with category names that are literal strings, which are all distinct. A later version may define other kinds of match (e.g. regexp), may specify some sort of ordering on the arguments, or any of several other semantic extensions. For more detail on the ongoing design, see https://rt.cpan.org/Ticket/Display.html?id=103545. then (multiple arguments) $future = $f1->then( \&done_code, @catch_list, \&fail_code ) Since version 0.33. The then method can be passed an even-sized list inbetween the $done_code and the $fail_code, with the same meaning as the catch method. transform $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. then_with_f $future = $f1->then_with_f( ... ) Since version 0.21. Returns a new sequencing Future that behaves like then, but also passes the original future, $f1, to any functions it invokes. $f2 = $done_code->( $f1, @result ) $f2 = $catch_code->( $f1, $category, @details ) $f2 = $fail_code->( $f1, $category, @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. then_done then_fail $future = $f->then_done( @result ) $future = $f->then_fail( $exception, $category, @details ) Since version 0.22. Convenient shortcuts to returning an immediate future from a then block, when the result is already known. else_with_f $future = $f1->else_with_f( \&code ) Since version 0.21. 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 other details. $f2 = $code->( $f1, $exception, $category, @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. else_done else_fail $future = $f->else_done( @result ) $future = $f->else_fail( $exception, $category, @details ) Since version 0.22. Convenient shortcuts to returning an immediate future from a else block, when the result is already known. catch_with_f $future = $f1->catch_with_f( ... ) Since version 0.33. Returns a new sequencing Future that behaves like catch, but also passes the original future, $f1, to any functions it invokes. followed_by $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 ) without_cancel $future = $f1->without_cancel Since version 0.30. 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. Note that this only prevents cancel propagating from $future to $f1; if the original $f1 instance is cancelled then the returned $future will have to be cancelled too. retain $f = $f->retain Since version 0.36. Creates a reference cycle which causes the future to remain in memory until it completes. Returns the invocant future. In normal situations, a Future instance does not strongly hold a reference to other futures that it is feeding a result into, instead relying on that to be handled by application logic. This is normally fine because some part of the application will retain the top-level Future, which then strongly refers to each of its components down in a tree. However, certain design patterns, such as mixed Future-based and legacy callback-based API styles might end up creating Futures simply to attach callback functions to them. In that situation, without further attention, the Future may get lost due to having no strong references to it. Calling ->retain on it creates such a reference which ensures it persists until it completes. For example: Future->needs_all( $fA, $fB ) ->on_done( $on_done ) ->on_fail( $on_fail ) ->retain; 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. wait_all $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 be 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. wait_any $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. needs_all $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. needs_any $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. pending_futures @f = $future->pending_futures ready_futures @f = $future->ready_futures done_futures @f = $future->done_futures failed_futures @f = $future->failed_futures cancelled_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 set_label label $future = $future->set_label( $label ) $label = $future->label Since version 0.28. 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. btime rtime [ $sec, $usec ] = $future->btime [ $sec, $usec ] = $future->rtime Since version 0.28. Accessors that return the tracing timestamps from the instance. These give the time the instance was constructed ("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. elapsed $sec = $future->elapsed Since version 0.28. 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. wrap_cb $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 argument 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 convenient to use the curry module to form a CODE reference that would invoke the done method. my $future = Future->new; do_something_async( foo => $args{foo}, on_done => $future->curry::done, ); 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->result; } ); 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->result; } 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 Syntax::Keyword::Try; $f->on_ready( sub { my $f = shift; try { say "The operation succeeded with: ", $f->result; } 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->result; say " bar: ", $f2->result; } ); 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 * Future::AsyncAwait - deferred subroutine syntax for futures Provides a neat syntax extension for writing future-based code. * Future::IO - Future-returning IO methods Provides methods similar to core IO functions, which yield results by Futures. * Promises - an implementation of the "Promise/A+" pattern for asynchronous programming A different alternative implementation of a similar idea. * 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.html * "Asynchronous Programming with Futures" - YAPC::EU 2014 https://www.youtube.com/watch?v=u9dZgFM6FtE TODO * Consider the ability to pass the constructor a block 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 Future-0.48/lib000755001750001750 014174113203 12202 5ustar00leoleo000000000000Future-0.48/lib/Future.pm000444001750001750 22310214174113203 14207 0ustar00leoleo000000000000# 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-2022 -- leonerd@leonerd.org.uk package Future; use v5.10; use strict; use warnings; no warnings 'recursion'; # Disable the "deep recursion" warning our $VERSION = '0.48'; 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; require Future::Exception; our @CARP_NOT = qw( Future::Utils ); use constant DEBUG => !!$ENV{PERL_FUTURE_DEBUG}; use constant STRICT => !!$ENV{PERL_FUTURE_STRICT}; our $TIMES = DEBUG || $ENV{PERL_FUTURE_TIMES}; =head1 NAME C - 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 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 or C methods. These are called "leaf" futures here, and are returned by the C 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 and C 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 which contains useful loop-constructing functions, to run a future-returning function repeatedly in a loop. Unless otherwise noted, the following methods require at least version I<0.08>. =head2 FAILURE CATEGORIES While not directly required by C or its related modules, a growing convention of C-using code is to encode extra semantics in the arguments given to the C method, to represent different kinds of failure. The convention is that after the initial message string as the first required argument (intended for display to humans), the second argument is a short lowercase string that relates in some way to the kind of failure that occurred. Following this is a list of details about that kind of failure, whose exact arrangement or structure are determined by the failure category. For example, L and L use this convention to indicate at what stage a given HTTP request has failed: ->fail( $message, http => ... ) # an HTTP-level error during protocol ->fail( $message, connect => ... ) # a TCP-level failure to connect a # socket ->fail( $message, resolve => ... ) # a resolver (likely DNS) failure # to resolve a hostname By following this convention, a module remains consistent with other C-based modules, and makes it easy for program logic to gracefully handle and manage failures by use of the C method. =head2 SUBCLASSING This class easily supports being subclassed to provide extra behavior, such as giving the C method the ability to block and wait for completion. This may be useful to provide C 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 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 overrides the L method, this will be called by C and C if the instance is still pending. 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 call to the function or method calls. my ( $results, $here ) = future_returning_function( @args )->get; =head2 DEBUGGING By the time a C 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 function within a C 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 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 or C methods are called on it, or it had at least one C or C callback, or its failure is propagated to another C instance (by a sequencing or converging method). =head2 Future::AsyncAwait::Awaitable ROLE Since version 0.43 this module provides the L API. Subclass authors should note that several of the API methods are provided by special optimised internal methods, which may require overriding in your subclass if your internals are different from that of this module. =cut =head1 CONSTRUCTORS =cut =head2 new $future = Future->new $future = $orig->new Returns a new C instance to represent a leaf future. It will be marked as ready by any of the C, C, or C 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 CB_SEQ_STRICT => 1<<9, # Complain if $code didn't return a Future }; 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" and ref $cop ne "B::NULL"; return $cv->GV->NAME if ref $cop eq "B::NULL"; 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 ); } *AWAIT_CLONE = sub { shift->new }; 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 done I<(class method)> =head2 fail I<(class method)> $future = Future->done( @values ) $future = Future->fail( $exception, $category, @details ) I Shortcut wrappers around creating a new C then immediately marking it as done or failed. =head2 wrap $future = Future->wrap( @values ) I If given a single argument which is already a C reference, this will be returned unmodified. Otherwise, returns a new C instance that is already complete, and will yield the given values. This will ensure that an incoming argument is definitely a C, and may be useful in such cases as adapting synchronous code to fit asynchronous libraries driven by C. =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 call $future = Future->call( \&code, @args ) I A convenient wrapper for calling a C 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 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}; $_->[0] and $_->[0]->_revoke_on_cancel( $_->[1] ) for @{ $self->{revoke_when_ready} }; delete $self->{revoke_when_ready}; my $callbacks = delete $self->{callbacks} or return; my $cancelled = $self->{cancelled}; my $fail = defined $self->{failure}; my $done = !$fail && !$cancelled; my @result = $done ? @{ $self->{result} } : $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" ) ) { # Upgrade a non-Future result, or complain in strict mode if( $flags & CB_SEQ_STRICT ) { $fseq->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); next; } $f2 = Future->done( $f2 ); } $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 : () ), ); } } } =head1 METHODS As there are a lare number of methods on this class, they are documented here in several sections. =cut =head1 INSPECTION METHODS The following methods query the internal state of a Future instance without modifying it or otherwise causing side-effects. =cut =head2 is_ready $ready = $future->is_ready Returns true on a leaf future if a result has been provided to the C method, failed using the C method, or cancelled using the C 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}; } *AWAIT_IS_READY = sub { shift->is_ready }; =head2 is_done $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 is_failed $failed = $future->is_failed I 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 is_cancelled $cancelled = $future->is_cancelled Returns true if the future has been cancelled by C. =cut sub is_cancelled { my $self = shift; return $self->{cancelled}; } *AWAIT_IS_CANCELLED = sub { shift->is_cancelled }; =head2 state $str = $future->state I Returns a string describing the state of the future, as one of the three states named above; namely C, C or C, or C if it is none of these. =cut 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 done $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. I this method is also available under the name C. =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} = [ @_ ]; if( $TIMES ) { $self->{rtime} = [ gettimeofday ]; } } return $self; } *resolve = sub { shift->done( @_ ) }; # TODO: For efficiency we can implement better versions of these as individual # methods know which case is being invoked *AWAIT_NEW_DONE = *AWAIT_DONE = sub { shift->done( @_ ) }; =head2 fail $future->fail( $exception, $category, @details ) Marks that the leaf future has failed, and provides an exception value. This exception will be thrown by the C method if called. The exception must evaluate as a true value; false exceptions are not allowed. A failure category name and other further details may be provided that will be returned by the C method in list context. 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. If passed a L instance (i.e. an object previously thrown by the C), the additional details will be preserved. This allows the additional details to be transparently preserved by such code as ... catch { return Future->fail($@); } I this method is also available under the name C. =cut sub fail { my $self = shift; my ( $exception, @more ) = @_; if( ref $exception eq "Future::Exception" ) { @more = ( $exception->category, $exception->details ); $exception = $exception->message; } $exception 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, @more ]; $self->_mark_ready( "failed" ); } else { $self = $self->new; $self->{ready} = 1; $self->{ready_at} = _shortmess "failed" if DEBUG; $self->{failure} = [ $exception, @more ]; if( $TIMES ) { $self->{rtime} = [ gettimeofday ]; } } return $self; } *reject = sub { shift->fail( @_ ) }; # TODO: For efficiency we can implement better versions of these as individual # methods know which case is being invoked *AWAIT_NEW_FAIL = *AWAIT_FAIL = sub { shift->fail( @_ ) }; =head2 die $future->die( $message, $category, @details ) I A convenient wrapper around C. 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 uses. Returns the C<$future>. =cut sub die :method { my $self = shift; my ( $exception, @more ) = @_; if( !ref $exception and $exception !~ m/\n$/ ) { $exception .= sprintf " at %s line %d\n", (caller)[1,2]; } $self->fail( $exception, @more ); } =head2 on_cancel $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 method. If the future is already ready the method is ignored. If the future is later cancelled, the callbacks will be invoked in the reverse order to that in which they were registered. $on_cancel->( $future ) If passed another C instance, the passed instance will be cancelled when the original future is cancelled. In this case, the reference is only strongly held while the target future remains pending. If it becomes ready, then there is no point trying to cancel it, and so it is removed from the originating future's cancellation list. =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; if( $is_future ) { push @{ $code->{revoke_when_ready} }, my $r = [ $self, \$self->{on_cancel}[-1] ]; weaken( $r->[0] ); weaken( $r->[1] ); } return $self; } # An optimised version for Awaitable role sub AWAIT_ON_CANCEL { my $self = shift; my ( $code ) = @_; push @{ $self->{on_cancel} }, $code; } sub AWAIT_CHAIN_CANCEL { my $self = shift; my ( $f2 ) = @_; push @{ $self->{on_cancel} }, $f2; push @{ $f2->{revoke_when_ready} }, my $r = [ $self, \$self->{on_cancel}[-1] ]; weaken( $r->[0] ); weaken( $r->[1] ); } sub _revoke_on_cancel { my $self = shift; my ( $ref ) = @_; undef $$ref; $self->{empty_on_cancel_slots}++; my $on_cancel = $self->{on_cancel} or return; # If the list is nontrivally large and over half-empty / under half-full, compact it if( @$on_cancel >= 8 and $self->{empty_on_cancel_slots} >= 0.5 * @$on_cancel ) { # We can't grep { defined } because that will break all the existing SCALAR refs my $idx = 0; while( $idx < @$on_cancel ) { defined $on_cancel->[$idx] and $idx++, next; splice @$on_cancel, $idx, 1, (); } $self->{empty_on_cancel_slots} = 0; } } =head1 USER METHODS These methods would primarily be used by users of asynchronous interfaces, on objects returned by such an interface. =cut =head2 on_ready $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 method. $on_ready->( $future ) If passed another C instance, the passed instance will have its C, C or C methods invoked when the original future completes successfully, fails, or is cancelled respectively. Returns the C<$future>. =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->{result} } ) : $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; } # An optimised version for Awaitable role sub AWAIT_ON_READY { my $self = shift; my ( $code ) = @_; push @{ $self->{callbacks} }, [ CB_ALWAYS|CB_SELF, $self->wrap_cb( on_ready => $code ) ]; } =head2 result @result = $future->result $result = $future->result I If the future is ready and completed successfully, returns the list of results that had earlier been given to the C 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 that was given to the C method. If additional details were given to the C method, an exception object is constructed to wrap them of type L. If the future was cancelled or is not yet ready an exception is thrown. =cut sub result { my $self = shift; $self->{ready} or Carp::croak( "${\$self->__selfstr} is not yet ready" ); if( my $failure = $self->{failure} ) { $self->{reported} = 1; my $exception = $failure->[0]; $exception = Future::Exception->new( @$failure ) if @$failure > 1; !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} }; } *AWAIT_RESULT = *AWAIT_GET = sub { shift->result }; =head2 get @result = $future->get $result = $future->get If the future is ready, returns the result or throws the failure exception as per L. If it is not yet ready then L is invoked to wait for a ready state, and the result returned as above. =cut sub get { my $self = shift; $self->await unless $self->{ready}; return $self->result; } =head2 await $f = $f->await I Blocks until the future instance is no longer pending. Returns the invocant future itself, so it is useful for chaining. Usually, calling code would either force the future using L, or use either C chaining or C syntax to wait for results. This method is useful in cases where the exception-throwing part of C is not required, perhaps because other code will be testing the result using L or similar. if( $f->await->is_done ) { ... } This method is intended for subclasses to override. The default implementation will throw an exception if called on a still-pending instance. =cut sub await { my $self = shift; return $self if $self->{ready}; Carp::croak "$self is not yet complete and does not provide ->await"; } =head2 block_until_ready $f = $f->block_until_ready I Now a synonym for L. New code should invoke C directly. =cut sub block_until_ready { my $self = shift; return $self->await; } =head2 unwrap @values = Future->unwrap( @values ) I If given a single argument which is a C reference, this method will call C 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 blocking wait, this method can only be used on immediate futures or subclasses that implement L. This will ensure that an outgoing argument is definitely not a C, and may be useful in such cases as adapting synchronous code to fit asynchronous libraries that return C 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 on_done $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 method. $on_done->( @result ) If passed another C instance, the passed instance will have its C method invoked when the original future completes successfully. Returns the C<$future>. =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->{result} } ) : $code->( @{ $self->{result} } ); } else { push @{ $self->{callbacks} }, [ CB_DONE|CB_RESULT, $self->wrap_cb( on_done => $code ) ]; } return $self; } =head2 failure $exception = $future->failure $exception, $category, @details = $future->failure If the future is ready, returns the exception passed to the C method or C if the future completed successfully via the C method. If it is not yet ready then L is invoked to wait for a ready state. If called in list context, will additionally yield the category name and list of the details provided to the C method. Because the exception value must be true, this can be used in a simple C statement: if( my $exception = $future->failure ) { ... } else { my @result = $future->result; ... } =cut sub failure { my $self = shift; $self->await unless $self->{ready}; return unless $self->{failure}; $self->{reported} = 1; return $self->{failure}->[0] if !wantarray; return @{ $self->{failure} }; } =head2 on_fail $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 other details passed to the C method. $on_fail->( $exception, $category, @details ) If passed another C instance, the passed instance will have its C method invoked when the original future fails. To invoke a C method on a future when another one fails, use a CODE reference: $future->on_fail( sub { $f->done( @_ ) } ); Returns the C<$future>. =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 cancel $future->cancel Requests that the future be cancelled, immediately marking it as ready. This will invoke all of the code blocks registered by C, 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}++; my $on_cancel = delete $self->{on_cancel}; foreach my $code ( $on_cancel ? reverse @$on_cancel : () ) { defined $code or next; my $is_future = blessed( $code ) && $code->isa( "Future" ); $is_future ? $code->cancel : $code->( $self ); } $self->_mark_ready( "cancel" ); return $self; } =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. The invoked code could return a future, or a result directly. I if a non-future result is returned it will be wrapped in a new immediate Future instance. This behaviour can be disabled by setting the C environment variable to a true value at compiletime: $ PERL_FUTURE_STRICT=1 perl ... 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. Note that since the code is invoked in scalar context, you cannot directly return a list of values this way. Any list-valued results must be done by returning a C instance. sub { ... return Future->done( @results ); } 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 ) = @_; $flags |= CB_SEQ_STRICT if STRICT; # 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->{result} } : $f1->{failure} ? @{ $f1->{failure} } : () : () ), ); my $fseq; unless( eval { $fseq = $code->( @args ); 1 } ) { return Future->fail( $@ ); } unless( blessed $fseq and $fseq->isa( "Future" ) ) { # Upgrade a non-Future result, or complain in strict mode $flags & CB_SEQ_STRICT and return Future->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); $fseq = $f1->new->done( $fseq ); } 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 then $future = $f1->then( \&done_code ) I Returns a new sequencing C 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 else $future = $f1->else( \&fail_code ) I Returns a new sequencing C that runs the code if the first fails. Once C<$f1> fails the code reference will be invoked and is passed the failure and other 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, $category, @details ) =head2 then I<(2 arguments)> $future = $f1->then( \&done_code, \&fail_code ) The C method can also be passed the C<$fail_code> block as well, giving a combination of C and C behaviour. This operation is similar to those provided by other future systems, such as Javascript's Q or Promises/A libraries. =cut my $make_donecatchfail_sub = sub { my ( $with_f, $done_code, $fail_code, @catch_list ) = @_; my $func = (caller 1)[3]; $func =~ s/^.*:://; !$done_code or _callable( $done_code ) or Carp::croak "Expected \$done_code to be callable in ->$func"; !$fail_code or _callable( $fail_code ) or Carp::croak "Expected \$fail_code to be callable in ->$func"; my %catch_handlers = @catch_list; _callable( $catch_handlers{$_} ) or Carp::croak "Expected catch handler for '$_' to be callable in ->$func" for keys %catch_handlers; sub { my $self = shift; my @maybe_self = $with_f ? ( $self ) : (); if( !$self->{failure} ) { return $self unless $done_code; return $done_code->( @maybe_self, @{ $self->{result} } ); } else { my $name = $self->{failure}[1]; if( defined $name and $catch_handlers{$name} ) { return $catch_handlers{$name}->( @maybe_self, @{ $self->{failure} } ); } return $self unless $fail_code; return $fail_code->( @maybe_self, @{ $self->{failure} } ); } }; }; sub then { my $self = shift; my $done_code = shift; my $fail_code = ( @_ % 2 ) ? pop : undef; my @catch_list = @_; if( $done_code and !@catch_list and !$fail_code ) { return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_RESULT ); } # Complex return $self->_sequence( $make_donecatchfail_sub->( 0, $done_code, $fail_code, @catch_list, ), 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 catch $future = $f1->catch( name => \&code, name => \&code, ... ) I Returns a new sequencing C that behaves like an C call which dispatches to a choice of several alternative handling functions depending on the kind of failure that occurred. If C<$f1> fails with a category name (i.e. the second argument to the C call) which exactly matches one of the string names given, then the corresponding code is invoked, being passed the same arguments as a plain C call would take, and is expected to return a C in the same way. $f2 = $code->( $exception, $category, @details ) If C<$f1> does not fail, fails without a category name at all, or fails with a category name that does not match any given to the C method, then the returned sequence future immediately completes with the same result, and no block of code is invoked. If passed an odd-sized list, the final argument gives a function to invoke on failure if no other handler matches. $future = $f1->catch( name => \&code, ... \&fail_code, ) This feature is currently still a work-in-progress. It currently can only cope with category names that are literal strings, which are all distinct. A later version may define other kinds of match (e.g. regexp), may specify some sort of ordering on the arguments, or any of several other semantic extensions. For more detail on the ongoing design, see L. =head2 then I<(multiple arguments)> $future = $f1->then( \&done_code, @catch_list, \&fail_code ) I The C method can be passed an even-sized list inbetween the C<$done_code> and the C<$fail_code>, with the same meaning as the C method. =cut sub catch { my $self = shift; my $fail_code = ( @_ % 2 ) ? pop : undef; my @catch_list = @_; return $self->_sequence( $make_donecatchfail_sub->( 0, undef, $fail_code, @catch_list, ), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); } =head2 transform $future = $f1->transform( %args ) Returns a new sequencing C 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 method is passed into this function, and whatever it returns is passed to the C 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 method is passed into this function, and whatever it returns is passed to the C 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->{result} } ); 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 then_with_f $future = $f1->then_with_f( ... ) I Returns a new sequencing C that behaves like C, but also passes the original future, C<$f1>, to any functions it invokes. $f2 = $done_code->( $f1, @result ) $f2 = $catch_code->( $f1, $category, @details ) $f2 = $fail_code->( $f1, $category, @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 then_with_f { my $self = shift; my $done_code = shift; my $fail_code = ( @_ % 2 ) ? pop : undef; my @catch_list = @_; if( $done_code and !@catch_list and !$fail_code ) { return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_SELF|CB_RESULT ); } return $self->_sequence( $make_donecatchfail_sub->( 1, $done_code, $fail_code, @catch_list, ), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); } =head2 then_done =head2 then_fail $future = $f->then_done( @result ) $future = $f->then_fail( $exception, $category, @details ) I Convenient shortcuts to returning an immediate future from a C 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 else_with_f $future = $f1->else_with_f( \&code ) I Returns a new sequencing C that runs the code if the first fails. Identical to C, except that the code reference will be passed both the original future, C<$f1>, and its exception and other details. $f2 = $code->( $f1, $exception, $category, @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 else_done =head2 else_fail $future = $f->else_done( @result ) $future = $f->else_fail( $exception, $category, @details ) I Convenient shortcuts to returning an immediate future from a C 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 catch_with_f $future = $f1->catch_with_f( ... ) I Returns a new sequencing C that behaves like C, but also passes the original future, C<$f1>, to any functions it invokes. =cut sub catch_with_f { my $self = shift; my $fail_code = ( @_ % 2 ) ? pop : undef; my @catch_list = @_; return $self->_sequence( $make_donecatchfail_sub->( 1, undef, $fail_code, @catch_list, ), CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); } =head2 followed_by $future = $f1->followed_by( \&code ) Returns a new sequencing C 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 ); } =head2 without_cancel $future = $f1->without_cancel I Returns a new sequencing C 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. Note that this only prevents cancel propagating from C<$future> to C<$f1>; if the original C<$f1> instance is cancelled then the returned C<$future> will have to be cancelled too. =cut sub without_cancel { my $self = shift; my $new = $self->new; $self->on_ready( sub { my $self = shift; if( $self->{cancelled} ) { $new->cancel; } elsif( $self->{failure} ) { $new->fail( @{ $self->{failure} } ); } else { $new->done( @{ $self->{result} } ); } }); $new->{orig} = $self; # just to strongref it - RT122920 $new->on_ready( sub { undef $_[0]->{orig} } ); return $new; } =head2 retain $f = $f->retain I Creates a reference cycle which causes the future to remain in memory until it completes. Returns the invocant future. In normal situations, a C instance does not strongly hold a reference to other futures that it is feeding a result into, instead relying on that to be handled by application logic. This is normally fine because some part of the application will retain the top-level Future, which then strongly refers to each of its components down in a tree. However, certain design patterns, such as mixed Future-based and legacy callback-based API styles might end up creating Futures simply to attach callback functions to them. In that situation, without further attention, the Future may get lost due to having no strong references to it. Calling C<< ->retain >> on it creates such a reference which ensures it persists until it completes. For example: Future->needs_all( $fA, $fB ) ->on_done( $on_done ) ->on_fail( $on_fail ) ->retain; =cut sub retain { my $self = shift; return $self->on_ready( sub { undef $self } ); } =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. =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 $sub"; } # 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 wait_all $future = Future->wait_all( @subfutures ) Returns a new C 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 be 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 my $self = $weakself; $pending--; $pending and return; $self->{result} = [ @subs ]; $self->_mark_ready( "wait_all" ); }; foreach my $sub ( @subs ) { $sub->{ready} or $sub->on_ready( $sub_on_ready ); } return $self; } =head2 wait_any $future = Future->wait_any( @subfutures ) Returns a new C 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->{result} } ]; } $self->_mark_ready( "wait_any" ); return $self; } my $pending = 0; weaken( my $weakself = $self ); my $sub_on_ready = sub { return unless my $self = $weakself; return if $self->{result} or $self->{failure}; # don't recurse on child ->cancel return if --$pending and $_[0]->{cancelled}; if( $_[0]->{cancelled} ) { $self->{failure} = [ "All component futures were cancelled" ]; } elsif( $_[0]->{failure} ) { $self->{failure} = [ @{ $_[0]->{failure} } ]; } else { $self->{result} = [ @{ $_[0]->{result} } ]; } foreach my $sub ( @subs ) { $sub->{ready} or $sub->cancel; } $self->_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 needs_all $future = Future->needs_all( @subfutures ) Returns a new C 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. 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 { @{ $_->{result} } } @subs ]; $self->_mark_ready( "needs_all" ); return $self; } weaken( my $weakself = $self ); my $sub_on_ready = sub { return unless my $self = $weakself; return if $self->{result} or $self->{failure}; # don't recurse on child ->cancel if( $_[0]->{cancelled} ) { $self->{failure} = [ "A component future was cancelled" ]; foreach my $sub ( @subs ) { $sub->cancel if !$sub->{ready}; } $self->_mark_ready( "needs_all" ); } elsif( $_[0]->{failure} ) { $self->{failure} = [ @{ $_[0]->{failure} } ]; foreach my $sub ( @subs ) { $sub->cancel if !$sub->{ready}; } $self->_mark_ready( "needs_all" ); } else { $pending--; $pending and return; $self->{result} = [ map { @{ $_->{result} } } @subs ]; $self->_mark_ready( "needs_all" ); } }; foreach my $sub ( @subs ) { $sub->{ready} or $sub->on_ready( $sub_on_ready ); } return $self; } =head2 needs_any $future = Future->needs_any( @subfutures ) Returns a new C 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. 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. Users should be careful to still check all the results from C 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->{result} } ]; $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 my $self = $weakself; return if $self->{result} or $self->{failure}; # don't recurse on child ->cancel return if --$pending and $_[0]->{cancelled}; if( $_[0]->{cancelled} ) { $self->{failure} = [ "All component futures were cancelled" ]; $self->_mark_ready( "needs_any" ); } elsif( $_[0]->{failure} ) { $pending and return; $self->{failure} = [ @{ $_[0]->{failure} } ]; $self->_mark_ready( "needs_any" ); } else { $self->{result} = [ @{ $_[0]->{result} } ]; foreach my $sub ( @subs ) { $sub->cancel if !$sub->{ready}; } $self->_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 pending_futures @f = $future->pending_futures =head2 ready_futures @f = $future->ready_futures =head2 done_futures @f = $future->done_futures =head2 failed_futures @f = $future->failed_futures =head2 cancelled_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. =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 set_label =head2 label $future = $future->set_label( $label ) $label = $future->label I Chaining mutator and accessor for the label of the C. 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 btime =head2 rtime [ $sec, $usec ] = $future->btime [ $sec, $usec ] = $future->rtime I Accessors that return the tracing timestamps from the instance. These give the time the instance was constructed ("birth" time, C) and the time the result was determined (the "ready" time, C). Each result is returned as a two-element ARRAY ref, containing the epoch time in seconds and microseconds, as given by C. 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 or C are set in the environment. =cut sub btime { my $self = shift; return $self->{btime}; } sub rtime { my $self = shift; return $self->{rtime}; } =head2 elapsed $sec = $future->elapsed I 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. =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 wrap_cb $cb = $future->wrap_cb( $operation_name, $cb ) I I 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 argument 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 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, C, C or C; 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 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 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 object to provide a fictional asynchronous API. For more examples, comparing the use of C with regular call/return style Perl code, see also L. =head2 Providing Results By returning a new C 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 method will simply be invoked with the entire result list as its arguments. In that case, it is convenient to use the L module to form a C reference that would invoke the C method. my $future = Future->new; do_something_async( foo => $args{foo}, on_done => $future->curry::done, ); The caller may then use this future to wait for a result using the C method, and obtain the result using C. my $f = foperation( foo => "something" ); $f->on_ready( sub { my $f = shift; say "The operation returned: ", $f->result; } ); =head2 Indicating Success or Failure Because the stored exception value of a failed future may not be false, the C 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->result; } else { say "The operation failed with: ", $e; } } ); By using C in the condition, the order of the C blocks can be arranged to put the successful case first, similar to a C/C block. Because the C method re-raises the passed exception if the future failed, it can be used to control a C/C block directly. (This is sometimes called I). use Syntax::Keyword::Try; $f->on_ready( sub { my $f = shift; try { say "The operation succeeded with: ", $f->result; } catch { say "The operation failed with: ", $_; } } ); Even neater still may be the separate use of the C and C 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 method returns the future object itself, it can be used to generate a C that is immediately ready with a result. This can also be used as a class method. my $f = Future->done( $value ); Similarly, the C and C methods can be used to generate a C that is immediately failed. my $f = Future->die( "This is never going to work" ); This could be considered similarly to a C call. An C block can be used to turn a C-returning function that might throw an exception, into a C that would indicate this failure. my $f = eval { function() } || Future->fail( $@ ); This is neater handled by the C class method, which wraps the call in an C block and tests the result: my $f = Future->call( \&function ); =head2 Sequencing The C method can be used to create simple chains of dependent tasks, each one executing and returning a C 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 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->result; say " bar: ", $f2->result; } ); This provides an ability somewhat similar to C or L. =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-style case it is likely that this situation should be treated as if C<$f1> had failed, perhaps with some special message. The C-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 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 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 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). =cut =head1 SEE ALSO =over 4 =item * L - deferred subroutine syntax for futures Provides a neat syntax extension for writing future-based code. =item * L - Future-returning IO methods Provides methods similar to core IO functions, which yield results by Futures. =item * L - an implementation of the "Promise/A+" pattern for asynchronous programming A different alternative implementation of a similar idea. =item * L - 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 =item * "Futures advent calendar 2013" L =item * "Asynchronous Programming with Futures" - YAPC::EU 2014 L =back =cut =head1 TODO =over 4 =item * Consider the ability to pass the constructor a C 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 itself - for example to allow a kind of Future that can report incremental progress. =back =cut =head1 AUTHOR Paul Evans =cut 0x55AA; Future-0.48/lib/Future000755001750001750 014174113203 13454 5ustar00leoleo000000000000Future-0.48/lib/Future/Exception.pm000444001750001750 602214174113203 16105 0ustar00leoleo000000000000# 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, 2019 -- leonerd@leonerd.org.uk package Future::Exception; use v5.10; use strict; use warnings; our $VERSION = '0.48'; =head1 NAME C - an exception type for failed Ls =head1 SYNOPSIS use Scalar::Util qw( blessed ); use Syntax::Keyword::Try; try { my $f = ...; my @result = $f->result; ... } catch { if( blessed($@) and $@->isa( "Future::Exception" ) { print STDERR "The ", $@->category, " failed: ", $@->message, "\n"; } } =head1 DESCRIPTION The C method on a failed L instance will throw an exception to indicate that the future failed. A failed future can contain a failure category name and other details as well as the failure message, so in this case the exception will be an instance of C to make these values accessible. Users should not depend on exact class name matches, but instead rely on inheritence, as a later version of this implementation might dynamically create subclasses whose names are derived from the Future failure category string, to assist with type matching. Note the use of C<< ->isa >> in the SYNOPSIS example. =cut use overload '""' => "message", fallback => 1; =head1 CONSTRUCTOR =head2 from_future $e = Future::Exception->from_future( $f ) Constructs a new C wrapping the given failed future. =cut sub from_future { my $class = shift; my ( $f ) = @_; return $class->new( $f->failure ); } sub new { my $class = shift; bless [ @_ ], $class; } =head1 ACCESSORS $message = $e->message $category = $e->category @details = $e->details Additionally, the object will stringify to return the message value, for the common use-case of printing, regexp testing, or other behaviours. =cut sub message { shift->[0] } sub category { shift->[1] } sub details { my $self = shift; @{$self}[2..$#$self] } =head1 METHODS =cut =head2 throw Future::Exception->throw( $message, $category, @details ) I Constructs a new exception object and throws it using C. This method will not return, as it raises the exception directly. If C<$message> does not end in a linefeed then the calling file and line number are appended to it, in the same way C does. =cut sub throw { my $class = shift; my ( $message, $category, @details ) = @_; $message =~ m/\n$/ or $message .= sprintf " at %s line %d.\n", ( caller )[1,2]; die $class->new( $message, $category, @details ); } # TODO: consider a 'croak' method that uses Carp::shortmess to find a suitable # file/linenumber =head2 as_future $f = $e->as_future Returns a new C object in a failed state matching the exception. =cut sub as_future { my $self = shift; return Future->fail( $self->message, $self->category, $self->details ); } =head1 AUTHOR Paul Evans =cut 0x55AA; Future-0.48/lib/Future/Mutex.pm000444001750001750 777514174113203 15271 0ustar00leoleo000000000000# 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, 2016-2020 -- leonerd@leonerd.org.uk package Future::Mutex; use v5.10; use strict; use warnings; our $VERSION = '0.48'; use Future; =head1 NAME C - mutual exclusion lock around code that returns Ls =head1 SYNOPSIS use Future::Mutex; my $mutex = Future::Mutex->new; sub do_atomically { return $mutex->enter( sub { ... return $f; }); } =head1 DESCRIPTION Most L-using code expects to run with some level of concurrency, using future instances to represent still-pending operations that will complete at some later time. There are occasions however, when this concurrency needs to be restricted - some operations that, once started, must not be interrupted until they are complete. Subsequent requests to perform the same operation while one is still outstanding must therefore be queued to wait until the first is finished. These situations call for a mutual-exclusion lock, or "mutex". A C instance provides one basic operation, which will execute a given block of code which returns a future, and itself returns a future to represent that. The mutex can be in one of two states; either unlocked or locked. While it is unlocked, requests to execute code are handled immediately. Once a block of code is invoked, the mutex is now considered to be locked, causing any subsequent requests to invoke code to be queued behind the first one, until it completes. Once the initial code indicates completion (by its returned future providing a result or failing), the next queued code is invoked. An instance may also be a counting mutex if initialised with a count greater than one. In this case, it can keep multiple blocks outstanding up to that limit, with subsequent requests queued as before. This allows it to act as a concurrency-bounding limit around some operation that can run concurrently, but an application wishes to apply overall limits to stop it growing too much, such as communications with external services or executing other programs. =cut =head1 CONSTRUCTOR =cut =head2 new $mutex = Future::Mutex->new( count => $n ) Returns a new C instance. It is initially unlocked. Takes the following named arguments: =over 8 =item count => INT Optional number to limit outstanding concurrency. Will default to 1 if not supplied. =back =cut sub new { my $class = shift; my %params = @_; return bless { avail => $params{count} // 1, waitf => undef, queue => [], }, $class; } =head1 METHODS =cut =head2 enter $f = $mutex->enter( \&code ) Returns a new C that represents the eventual result of calling the code. If the mutex is currently unlocked, the code will be invoked immediately. If it is currently locked, the code will be queued waiting for the next time it becomes unlocked. The code is invoked with no arguments, and is expected to return a C. The eventual result of that future determines the result of the future that C returned. =cut sub enter { my $self = shift; my ( $code ) = @_; my $down_f; if( $self->{avail} ) { $self->{avail}--; $down_f = Future->done; } else { die "ARGH Need to clone an existing future\n" unless defined $self->{waitf}; push @{ $self->{queue} }, $down_f = $self->{waitf}->new; } my $up = sub { if( my $next_f = shift @{ $self->{queue} } ) { $next_f->done; } else { $self->{avail}++; undef $self->{waitf}; } }; my $retf = $down_f->then( $code )->on_ready( $up ); $self->{waitf} or $self->{waitf} = $retf; return $retf; } =head2 available $avail = $mutex->available Returns true if the mutex is currently unlocked, or false if it is locked. =cut sub available { my $self = shift; return $self->{avail}; } =head1 AUTHOR Paul Evans =cut 0x55AA; Future-0.48/lib/Future/Phrasebook.pod000444001750001750 3460014174113203 16435 0ustar00leoleo000000000000# 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 - coding examples for C and C This documentation-only module provides a phrasebook-like approach to giving examples on how to use L and L 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 to make them stand out. In the examples showing use of Futures, any function that is expected to return a C instance is named with a leading C 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 before calling the second. my $f = F_FIRST() ->then( sub { F_SECOND(); } ); Here, the anonymous closure is invoked once the C returned by C succeeds. Because C invokes the code block only if the first Future succeeds, it shortcircuits around failures similar to the way that C shortcircuits around thrown exceptions. A C representing the entire combination is returned by the method. Because the C method itself returns a C 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 is passed into the code block given to the C 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 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 or C is aborted, and control is passed to the corresponding C or line after the C. try { FIRST(); } catch { my $e = $_; ERROR( $e ); }; The C method on a C can be used here. It behaves similar to C, but is only invoked if the initial C fails; not if it succeeds. my $f = F_FIRST() ->else( sub { F_ERROR( @_ ); } ); Alternatively, the second argument to the C 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. In that case, the C code block can return an immediate C 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 block could return a new C failed with the same exception, the C block is passed the failed C 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 method is similar again, though it invokes the code block regardless of the success or failure of the initial C. It can be used to create C semantics. By returning the C instance that it was passed, the C 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 block is often used. while( COND() ) { FUNC(); } The C function can be used to repeatedly iterate a given C-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 block, this C C 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, it can be combined along with the loop body. The trial C returned by the code block is passed to the C condition function. my $f = repeat { F_FUNC() ->followed_by( sub { F_COND(); } ); } while => sub { shift->result }; The condition can be negated by using C 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 loop in plain Perl, because the C loop will also stop executing if the code within it throws an exception. This can be handled in C by testing for a failed C in the C 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 function should be used. Currently this function behaves equivalently to C, 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 function so that yields a warning. my $f = try_repeat { F_TRIAL(); } while => sub { shift->failure }; Another variation is the C function, which provides a convenient shortcut to calling C 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 loop is the C 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 using the C parameter to the C 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-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 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 more into it, while also being used as the actual C 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 or C 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 to return a value from a function immediately, or C for immediately stopping execution of a loop. sub func { foreach my $item ( @LIST ) { if( COND($item) ) { return $item; } } return MAKE_NEW_ITEM(); } The C 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. 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 or C), 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 chain of the C block followed by C) 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 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-using version to behave concurrently. =head2 Waiting on Multiple Functions The C<< Future->wait_all >> constructor creates a C 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 and C concurrently, only proceeding to C when both are ready. The result of the C C is the list of its component Cs. 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->result, $f_b->result ); } ); Because the C method will re-raise an exception caused by a failure of either of the C 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 method of a C 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 and C constructors take an entire list of C instances, they can be conveniently used with C 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 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 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 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 and C functions return a Future that will eventually give the collected results of the individual item futures, thus making them similar to perl's C 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 function variant of the C 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 =cut Future-0.48/lib/Future/Queue.pm000444001750001750 431014174113203 15231 0ustar00leoleo000000000000# 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, 2019 -- leonerd@leonerd.org.uk package Future::Queue; use v5.10; use strict; use warnings; our $VERSION = '0.48'; =head1 NAME C - a FIFO queue of values that uses Ls =head1 SYNOPSIS use Future::Queue; my $queue = Future::Queue->new; my $f = repeat { $queue->shift->then(sub { my ( $thing ) = @_; ... }); }; $queue->push( "a thing" ); =head1 DESCRIPTION Objects in this class provide a simple FIFO queue the stores arbitrary perl values. Values may be added into the queue using the L method, and retrieved from it using the L method. Values may be stored within the queue object for C to retrieve later, or if the queue is empty then the future that C returns will be completed once an item becomes available. =cut =head1 CONSTRUCTOR =cut =head2 new $queue = Future::Queue->new Returns a new C instance. =cut sub new { my $class = shift; return bless { items => [], waiters => [], }, $class; } =head2 push $queue->push( $item ) Adds a new item into the queue. If the queue was previously empty and there is at least one C future waiting, then the next one will be completed by this method. =cut sub push :method { my $self = shift; my ( $item ) = @_; push @{ $self->{items} }, $item; ( shift @{ $self->{waiters} } )->done if @{ $self->{waiters} }; } =head2 shift $item = $queue->shift->get Returns a C that will yield the next item from the queue. If there is already an item then this will be taken and the returned future will be immediate. If not, then the returned future will be pending, and the next C method will complete it. =cut sub shift :method { my $self = shift; if( @{ $self->{items} } ) { return Future->done( shift @{ $self->{items} } ); } push @{ $self->{waiters} }, my $f = Future->new; return $f->then(sub { return Future->done( shift @{ $self->{items} } ); }); } =head1 AUTHOR Paul Evans =cut 0x55AA; Future-0.48/lib/Future/Utils.pm000444001750001750 5141114174113203 15271 0ustar00leoleo000000000000# 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-2016 -- leonerd@leonerd.org.uk package Future::Utils; use v5.10; use strict; use warnings; our $VERSION = '0.48'; 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 - utility functions for working with C 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 $trial_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; Unless otherwise noted, the following functions require at least version I<0.08>. =cut =head1 INVOKING A BLOCK OF CODE =head2 call $f = call { CODE } I The C function invokes a block of code that returns a future, and simply returns the future it returned. The code is wrapped in an C block, so that if it throws an exception this is turned into an immediate failed C. If the code does not return a C, then an immediate failed C 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 call_with_escape $f = call_with_escape { CODE } I The C 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 function. However, if the code captures this future and completes it by calling C or C on it, the future returned by C 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 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 function provides a way to repeatedly call a block of code that returns a L (called here a "trial future") until some ending condition is satisfied. The C function itself returns a C 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 is required as the return value, it can be passed as the C argument. Otherwise the return value will be constructed by cloning the first non-immediate trial C. =head2 repeat+while $future = repeat { CODE } while => CODE Repeatedly calls the C block while the C condition returns a true value. Each time the trial future completes, the C 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 with the exception as the future's failure. The exception will not be propagated to the caller. =head2 repeat+until $future = repeat { CODE } until => CODE Repeatedly calls the C block until the C condition returns a true value. Each time the trial future completes, the C condition is passed the trial future. $trial_f = $code->( $previous_trial_f ) $accept = $until->( $trial_f ) =head2 repeat+foreach $future = repeat { CODE } foreach => ARRAY, otherwise => CODE I Calls the C 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 code is invoked once and passed the last trial future, if there was one, or C if the list was originally empty. The result of the eventual future will be the result of the future returned from C. The referenced array may be modified by this operation. $trial_f = $code->( $item, $previous_trial_f ) $final_f = $otherwise->( $last_trial_f ) The C 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 list was already empty, then an immediate successful future with an empty result is returned. =head2 repeat+foreach+while $future = repeat { CODE } foreach => ARRAY, while => CODE, ... I =head2 repeat+foreach+until $future = repeat { CODE } foreach => ARRAY, until => CODE, ... I Combines the effects of C with C or C. Calls the C block once for each value obtained from the array, until the array is exhausted or the given ending condition is satisfied. If a C or C condition is combined with C, the C code will only be run if the array was entirely exhausted. If the operation is terminated early due to the C or C condition being satisfied, the eventual result will simply be that of the last trial that was executed. =head2 repeat+generate $future = repeat { CODE } generate => CODE, otherwise => CODE I Calls the C 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 code is invoked and passed the last trial future, if there was one, otherwise C if the generator never returned a value. The result of the eventual future will be the result of the future returned from C. $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 or C 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 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 try_repeat $future = try_repeat { CODE } ... I A variant of C that doesn't warn when the trial fails and the condition code asks for it to be repeated. In some later version the C 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 loop in Perl. Code that specifically wishes to catch failures in trial futures and retry the block should use C specifically. =cut sub try_repeat(&@) { # defeat prototype &repeat( @_, try => 1 ); } =head2 try_repeat_until_success $future = try_repeat_until_success { CODE } ... I A shortcut to calling C with an ending condition that simply tests for a successful result from a future. May be combined with C or C. This function used to be called C, 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 family of functions provide a way to call a block of code that returns a L (called here an "item future") once per item in a given list, or returned by a generator function. The C functions themselves return a C to represent the ongoing operation, which completes when every item's future has completed. While this behaviour can also be implemented using C, the main reason to use an C 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 function: =over 8 =item foreach => ARRAY Provides the list of items to iterate over, as an C reference. The referenced array will be modified by this operation, Cing one item from it each time. The can C 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 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. For similarity with perl's core C function, the item is also available aliased as C<$_>. =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, local $_ = $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 { !defined $_ or $_->is_ready or $_->cancel for @slots; }); return $future; } =head2 fmap_concat $future = fmap_concat { CODE } ... I This version of C 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 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 references and final flattening operation used to implement this behaviour, this function is slightly less efficient than C or C 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 to emphasise its similarity to perl's C 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 fmap_scalar $future = fmap_scalar { CODE } ... I This version of C acts more like the C 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 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. =cut sub fmap_scalar(&@) { my $code = shift; my %args = @_; _fmap( $code, %args, collect => "scalar" ) } *fmap1 = \&fmap_scalar; =head2 fmap_void $future = fmap_void { CODE } ... I This version of C 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. =cut sub fmap_void(&@) { my $code = shift; my %args = @_; _fmap( $code, %args, collect => "void" ) } *fmap0 = \&fmap_void; =head1 AUTHOR Paul Evans =cut 0x55AA; Future-0.48/lib/Test000755001750001750 014174113203 13121 5ustar00leoleo000000000000Future-0.48/lib/Test/Future.pm000444001750001750 700614174113203 15071 0ustar00leoleo000000000000# 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-2015 -- leonerd@leonerd.org.uk package Test::Future; use v5.10; use strict; use warnings; use base qw( Test::Builder::Module ); our $VERSION = '0.48'; 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 - unit test assertions for L 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 instances or subclasses. =cut =head1 FUNCTIONS =cut =head2 no_pending_futures no_pending_futures( \&code, $name ) I Runs the given block of code, while keeping track of every C 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 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 is the number of the test that failed (in case there was more than one). A list of addresses of C 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 instances at all. The block of code may contain other testing assertions; they will be run before the assertion by C 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 =cut 0x55AA; Future-0.48/lib/Test/Future000755001750001750 014174113203 14373 5ustar00leoleo000000000000Future-0.48/lib/Test/Future/Deferred.pm000444001750001750 450314174113203 16610 0ustar00leoleo000000000000# 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, 2018 -- leonerd@leonerd.org.uk package Test::Future::Deferred; use v5.10; use strict; use warnings; use base qw( Future ); our $VERSION = '0.48'; =head1 NAME C - a future which completes later my $future = Test::Future::Deferred->done_later( 1, 2, 3 ); # Future is not ready yet my @result = $future->get; =head1 DESCRIPTION This subclass of L provides two new methods and an implementation of the C interface, which allows the futures to appear pending at first, but then to complete when C is called at the toplevel on one of them. This behaviour is useful in unit tests to check that behaviour of a module under test is correct even with non-immediate futures, as it allows a future to easily be constructed that will complete "soon", but not yet, without needing an event loop. Because these futures provide their own C method, they shouldn't be mixed in the same program with other kinds of futures from real event systems or similar. =cut my @deferrals; sub await { while( my $d = shift @deferrals ) { my ( $f, $method, @args ) = @$d; $f->$method( @args ); } # TODO: detect if still not done with no more deferrals } =head1 METHODS =cut =head2 done_later $f->done_later( @args ) Equivalent to invoking the regular C method as part of the C operation called on the toplevel future. This makes the future complete with the given result, but only when C is called. =cut sub done_later { my $self = ref $_[0] ? shift : shift->new; push @deferrals, [ $self, done => @_ ]; return $self; } =head2 fail_later $f->fail_later( $message, $category, @details ) Equivalent to invoking the regular C method as part of the C operation called on the toplevel future. This makes the future complete with the given failure, but only when C is called. As the C method also waits for completion of the future, then it will return the failure message given here also. =cut sub fail_later { my $self = ref $_[0] ? shift : shift->new; push @deferrals, [ $self, fail => @_ ]; return $self; } =head1 AUTHOR Paul Evans =cut 0x55AA; Future-0.48/t000755001750001750 014174113203 11677 5ustar00leoleo000000000000Future-0.48/t/00use.t000444001750001750 20614174113203 13133 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use_ok( "Future" ); use_ok( "Future::Utils" ); done_testing; Future-0.48/t/01future.t000444001750001750 2303514174113203 13717 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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' ); is( $future->state, "pending", '$future->state before done' ); 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( $future->state, "done", '$future->state after done' ); is_deeply( [ $future->result ], [ result => "here" ], 'Results from $future->result' ); is( scalar $future->result, "result", 'Result from scalar $future->result' ); 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->result, "Wrapped Future", 'Future->wrap(Future)->result' ); $future = Future->wrap( "Plain string" ); ok( defined $future, 'Future->wrap(string) defined' ); isa_ok( $future, "Future", 'Future->wrap(string)' ); is( scalar $future->result, "Plain string", 'Future->wrap(string)->result' ); } # 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->result ], [ 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->result ], [ 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( $future->state, "failed", '$future->state after fail' ); is( scalar $future->failure, "Something broke", '$future->failure yields exception' ); my $file = __FILE__; my $line = __LINE__ + 1; like( exception { $future->result }, qr/^Something broke at \Q$file line $line\E\.?\n$/, '$future->result throws exception' ); is( $failure, "Something broke", 'Exception passed to on_fail' ); } { 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->result }, "Something broke at $file line $line\n", '$future->result 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->result ], [ 1, 2, 3 ], '$future->result 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; } # retain { my @args; foreach my $method (qw( cancel done fail )) { my $f = Future->new; is_oneref( $f, 'start with refcount 1' ); is( $f->retain, $f, '->retain returns original Future' ); is_refcount( $f, 2, 'refcount is now increased' ); ok( $f->$method( @args ), "can call ->$method" ); is_oneref( $f, 'refcount drops when completed' ); push @args, 'x'; } } # await { my $future = Future->done( "result" ); identical( $future->await, $future, '->await returns invocant' ); } # ->result while pending { like( exception { Future->new->result; }, qr/^Future=HASH\(0x[0-9a-f]+\) is not yet ready /, '->result while pending raises exception' ); } # resolve and reject aliases { my $fdone = Future->resolve( "abc" ); ok( $fdone->is_done, 'Future->resolve' ); my $ffail = Future->reject( "def\n" ); ok( $ffail->is_failed, 'Future->reject' ); } done_testing; Future-0.48/t/02cancel.t000444001750001750 1145414174113203 13635 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Test::Fatal; use Test::Identity; use Test::Refcount; 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' ); is( $future->state, "cancelled", '$future->state after ->cancel' ); like( exception { $future->result }, qr/cancelled/, '$future->result throws exception by cancel' ); is( exception { $future->cancel }, undef, '$future->cancel a second time is OK' ); $done_f->cancel; $fail_f->cancel; } # 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; my $f3 = Future->new; $f1->on_cancel( $f2 ); $f1->on_cancel( $f3 ); is_oneref( $f1, '$f1 has refcount 1 after on_cancel chaining' ); is_refcount( $f2, 2, '$f2 has refcount 2 after on_cancel chaining' ); is_refcount( $f3, 2, '$f3 has refcount 2 after on_cancel chaining' ); $f3->done; is_oneref( $f3, '$f3 has refcount 1 after done in cancel chain' ); my $cancelled; $f2->on_cancel( sub { $cancelled++ } ); $f1->cancel; is( $cancelled, 1, 'Chained cancellation' ); } # test amortized compaction { my $f = Future->new; my @subf; push @subf, Future->new and $f->on_cancel( $subf[-1] ) for 1 .. 100; # gutwrench is( scalar @{ $f->{on_cancel} }, 100, '$f on_cancel list is 100 items initially' ); # We should be able to cancel the first 49 of these without triggering a compaction $_->done for @subf[0..48]; # gutwrench is( scalar @{ $f->{on_cancel} }, 100, '$f on_cancel list still 100 items' ); # Cancelling the next one will cause a compaction $_->done for $subf[49]; # gutwrench is( scalar @{ $f->{on_cancel} }, 50, '$f on_cancel list now only 50 items' ); # Cancelling most of the rest will compact again $_->done for @subf[50..90]; # gutwrench is( scalar @{ $f->{on_cancel} }, 12, '$f on_cancel list now only 12 items' ); $f->cancel; } # ->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; is_oneref( $f1, '$f1 has single reference initially' ); my $f2 = $f1->without_cancel; is_refcount( $f1, 2, '$f1 has two references after ->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->result ], [ "result" ], 'result of $f3' ); is_oneref( $f1, '$f1 has one reference after done' ); $f1 = Future->new; $f2 = $f1->without_cancel; $f1->cancel; ok( $f2->is_cancelled, '$f1 cancelled still cancels $f2' ); } done_testing; Future-0.48/t/03then.t000444001750001750 1532714174113203 13352 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ results => "here" ], '$fseq->result 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->result, "Final", '$fseq->result 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->result, "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 is upgraded { my $f1 = Future->new; my $fseq = $f1->then( sub { "result" } ); my $fseq2 = $f1->then( sub { Future->done } ); is( exception { $f1->done }, undef, '->done with non-Future return from ->then does not die' ); is( scalar $fseq->result, "result", 'non-Future return from ->then is upgraded' ); ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); my $fseq3; is( exception { $fseq3 = $f1->then( sub { "result" } ) }, undef, 'non-Future return from ->then on immediate does not die' ); is( scalar $fseq3->result, "result", 'non-Future return from ->then on immediate is upgraded' ); } # 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->result, "f2 result", '$fseq->result 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->result ], [ second => "result" ], '$fseq->result 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->result ], [ third => "result" ], '$fseq2->result 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; Future-0.48/t/04else.t000444001750001750 1421514174113203 13340 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ 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->result ], [ results => "here" ], '$fseq->result 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->result, "It works", '$fseq->result 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 is upgraded { my $f1 = Future->new; my $fseq = $f1->else( sub { "result" } ); my $fseq2 = $f1->else( sub { Future->done } ); is( exception { $f1->fail( "failed\n" ) }, undef, '->fail with non-Future return from ->else does not die' ); is( scalar $fseq->result, "result", 'non-Future return from ->else is upgraded' ); ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); my $fseq3; is( exception { $fseq3 = $f1->else( sub { "result" } ) }, undef, 'non-Future return from ->else on immediate does not die' ); is( scalar $fseq3->result, "result", 'non-Future return from ->else on immediate is upgraded' ); } # 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->result, "f2 result", '$fseq->result 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->result ], [ second => "result" ], '$fseq->result 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->result ], [ third => "result" ], '$fseq2->result returns result for else_done on immediate' ); my $f2 = Future->new; $fseq = $f2->else_done( "result2" ); $f2->done( "result" ); is( scalar $fseq->result, "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->result, "result", '->else_fail ignores success' ); } done_testing; Future-0.48/t/05then-else.t000444001750001750 422414174113203 14254 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ results => "here" ], '$fseq->result 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->result ], [ fallback => "result" ], '$fseq->result 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' ); } # then_with_f { my $f1 = Future->new; my $fseq = $f1->then_with_f( sub { identical( $_[0], $f1, 'then_with_f done block passed $f1' ); is( $_[1], "f1 result", 'then_with_f done block passed result of $f1' ); Future->done; }, sub { die "then_with_f fail block should not be called"; }, ); $f1->done( "f1 result" ); ok( $fseq->is_ready, '$fseq is ready after $f1 done' ); } done_testing; Future-0.48/t/06followed_by.t000444001750001750 1073014174113203 14715 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ results => "here" ], '$fseq->result 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->failure 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 is upgraded { my $f1 = Future->new; my $fseq = $f1->followed_by( sub { "result" } ); my $fseq2 = $f1->followed_by( sub { Future->done } ); is( exception { $f1->done }, undef, '->done with non-Future return from ->followed_by does not die' ); is( scalar $fseq->result, "result", 'non-Future return from ->followed_by is upgraded' ); ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); my $fseq3; is( exception { $fseq3 = $f1->followed_by( sub { "result" } ) }, undef, 'non-Future return from ->followed_by on immediate does not die' ); is( scalar $fseq3->result, "result", 'non-Future return from ->followed_by on immediate is upgraded' ); } done_testing; Future-0.48/t/07catch.t000444001750001750 610014174113203 13447 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Test::Refcount; use Future; # catch success { my $f1 = Future->new; my $fseq = $f1->catch( test => sub { die "catch 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->result ], [ results => "here" ], '$fseq succeeds when $f1 succeeds' ); undef $f1; is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); } # catch matching failure { my $f1 = Future->new; my $f2; my $fseq = $f1->catch( test => sub { is( $_[0], "f1 failure\n", 'catch block passed result of $f1' ); return $f2 = Future->done; }, ); ok( defined $fseq, '$fseq defined' ); isa_ok( $fseq, "Future", '$fseq' ); is_oneref( $fseq, '$fseq has refcount 1 initially' ); $f1->fail( "f1 failure\n", test => ); 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 is done after $f2 done' ); } # catch non-matching failure { my $f1 = Future->new; my $fseq = $f1->catch( test => sub { die "catch of non-matching Failure should not be invoked" }, ); $f1->fail( "f1 failure\n", different => ); ok( $fseq->is_ready, '$fseq is done after $f1 fail' ); is( scalar $fseq->failure, "f1 failure\n", '$fseq failure' ); } # catch default handler { my $fseq = Future->fail( "failure", other => ) ->catch( test => sub { die "'test' catch should not match" }, sub { Future->done( default => "handler" ) }, ); is_deeply( [ $fseq->result ], [ default => "handler" ], '->catch accepts a default handler' ); } # catch_with_f { my $f1 = Future->new; my $fseq = $f1->catch_with_f( test => sub { identical( $_[0], $f1, '$f1 passed to catch code' ); is( $_[1], "f1 failure\n", '$f1 failure message passed to catch code' ); Future->done; }, ); ok( defined $fseq, 'defined $fseq' ); isa_ok( $fseq, "Future", '$fseq' ); $f1->fail( "f1 failure\n", test => ); ok( $fseq->is_ready, '$fseq is done after $f1 fail' ); } # catch via 'then' { is( scalar ( Future->fail( "message", test => ) ->then( sub { die "then &done should not be invoked" }, test => sub { Future->done( 1234 ) }, sub { die "then &fail should not be invoked" } )->result ), 1234, 'catch semantics via ->then' ); } # catch via 'then_with_f' { my $f1 = Future->new; my $fseq = $f1->then_with_f( sub { die "then &done should not be invoked" }, test => sub { identical( $_[0], $f1, '$f1 passed to catch code' ); is( $_[1], "f1 failure\n", '$f1 failure message passed to catch code' ); Future->done; } ); $f1->fail( "f1 failure\n", test => ); ok( $fseq->is_ready, '$fseq is done after $f1 fail' ); } done_testing; Future-0.48/t/09transform.t000444001750001750 245714174113203 14415 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ 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; Future-0.48/t/10wait_all.t000444001750001750 1033714174113203 14202 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result; identical( $results[0], $f1, 'Results[0] from $future->result is f1' ); identical( $results[1], $f2, 'Results[1] from $future->result 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->result; identical( $results[0], $f1, 'Results from $future->result 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->result; identical( $results[0], $f1, 'Results from $future->result 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->result ], [], '->result on empty wait_all is empty' ); } done_testing; Future-0.48/t/11wait_any.t000444001750001750 1044514174113203 14222 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ one => 1 ], 'results from $future->result' ); 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->result }, "It fails\n", '$future->result 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", '->result on empty wait_any is empty' ); } # wait_any instance disappearing partway through cancellation (RT120468) { my $f = Future->new; my $wait; $wait = Future->wait_any( $f, my $cancelled = Future->new->on_cancel( sub { undef $wait; }), ); is( exception { $f->done(1) }, undef, 'no problems cancelling a Future which clears the original ->wait_any ref' ); ok( $cancelled->is_cancelled, 'cancellation occurred as expected' ); ok( $f->is_done, '->wait_any is marked as done' ); } done_testing; Future-0.48/t/12needs_all.t000444001750001750 1006714174113203 14336 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ one => 1, two => 2 ], '$future->result 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->result }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->result 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->result ], [], '->result on empty needs_all is empty' ); } # weakself retention (RT120468) { my $f = Future->new; my $wait; $wait = Future->needs_all( $f, my $cancelled = Future->new->on_cancel( sub { undef $wait; }), ); is( exception { $f->fail("oopsie\n") }, undef, 'no problems cancelling a Future which clears the original ->needs_all ref' ); ok( $cancelled->is_cancelled, 'cancellation occured as expected' ); ok( $f->is_failed, '->needs_all is marked as done' ); } done_testing; Future-0.48/t/13needs_any.t000444001750001750 1257014174113203 14357 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result ], [ one => 1 ], 'results from $future->result' ); 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->result ], [ two => 2 ], '$future->result 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->result }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->result 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", '->result on empty needs_any is empty' ); } # weakself retention (RT120468) { my $f = Future->new; my $wait; $wait = Future->needs_any( $f, my $cancelled = Future->new->on_cancel( sub { undef $wait; }), ); is( exception { $f->done(1) }, undef, 'no problems cancelling a Future which clears the original ->needs_any ref' ); ok( $cancelled->is_cancelled, 'cancellation occured as expected' ); ok( $f->is_done, '->needs_any is marked as done' ); } done_testing; Future-0.48/t/20subclass.t000444001750001750 732614174113203 14212 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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 subclass->... { my $fdone = t::Future::Subclass->new->done; my $ffail = t::Future::Subclass->new->fail( "Oop\n" ); isa_ok( $fdone->then( sub { 1 } ), "t::Future::Subclass", 'immediate $f->then' ); isa_ok( $ffail->else( sub { 1 } ), "t::Future::Subclass", 'immediate $f->else' ); isa_ok( $fdone->then_with_f( sub {} ), "t::Future::Subclass", 'immediate $f->then_with_f' ); isa_ok( $ffail->else_with_f( sub {} ), "t::Future::Subclass", 'immediate $f->else_with_f' ); isa_ok( $fdone->followed_by( sub {} ), "t::Future::Subclass", '$f->followed_by' ); } # 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; } # ->get calls the correct await { my $f = t::Future::Subclass->new; my $called; no warnings 'once'; local *t::Future::Subclass::await = sub { $called++; identical( $_[0], $f, '->await is called on $f' ); $_[0]->done( "Result here" ); }; is_deeply( [ $f->get ], [ "Result here" ], 'Result from ->get' ); ok( $called, '$f->await called' ); } done_testing; package t::Future::Subclass; use base qw( Future ); Future-0.48/t/21debug.t000444001750001750 500714174113203 13454 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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' ); my $imm = Future->done; ok( defined $imm->rtime, 'Immediate future has rtime' ); ok( defined $imm->elapsed, 'Immediate future has ->elapsed time' ); ok( $imm->elapsed >= 0, 'Immediate future elapsed time >= 0' ); } done_testing; Future-0.48/t/22wrap_cb.t000444001750001750 301314174113203 13777 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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; Future-0.48/t/23exception.t000444001750001750 357414174113203 14375 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Test::Fatal; use Future; # ->result throws an object { my $f = Future->fail( "message\n", category => qw( a b ) ); my $e = exception { $f->result }; # TODO: some sort of predicate test function to check this is( $e->message, "message\n", '$e->message from exceptional get' ); is( $e->category, "category", '$e->category from exceptional get' ); is_deeply( [ $e->details ], [qw( a b )], '$e->details from exceptional get' ); # Still stringifies OK is( "$e", "message\n", '$e stringifies properly' ); my $f2 = $e->as_future; is_deeply( [ $f2->failure ], [ "message\n", category => qw( a b ) ], '$e->as_future returns a failed Future' ); } # ->fail can accept an exception object { my $e = Future::Exception->from_future( Future->fail( "message\n", category => qw( c d ) ) ); my $f = Future->fail( $e ); is_deeply( [ $f->failure ], [ "message\n", category => qw( c d ) ], '->failure from Future->fail on wrapped exception' ); } # ->call can rethrow the same { my $f1 = Future->fail( "message\n", category => qw( e f ) ); my $f2 = Future->call( sub { $f1->result; }); ok( $f2->is_failed, '$f2 failed' ); is_deeply( [ $f2->failure ], [ "message\n", category => qw( e f ) ], '->failure from Future->call on rethrown failure' ); } # Future::Exception->throw { my $e = exception { Future::Exception->throw( "message\n", category => qw( g h ) ) }; is( $e->message, "message\n", '$e->message from F::E->throw' ); is( $e->category, "category", '$e->category from F::E->throw' ); is_deeply( [ $e->details ], [qw( g h )], '$e->details from F::E->throw' ); $e = exception { Future::Exception->throw( "short", category => ) }; like( $e->message, qr/^short at \S+ line \d+\.$/, 'F::E->throw appends file/line' ); } done_testing; Future-0.48/t/30utils-call.t000444001750001750 163014174113203 14435 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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; Future-0.48/t/31utils-call-with-escape.t000444001750001750 314514174113203 16650 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result, "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->result, "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->result, "later escape", 'result of call_with_escape' ); ok( $inner_f->is_cancelled, 'code-returned future cancelled after escape' ); } done_testing; Future-0.48/t/32utils-repeat.t000444001750001750 1106414174113203 15026 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result, "one", '$arg->result 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->result, "two", '$future->result' ); } # 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->result, "three", '$arg->result for first' ); $accept = 1; $trial_f->done( "four" ); ok( $future->is_ready, '$future is now ready after second attempt ->done' ); is( scalar $future->result, "four", '$future->result' ); } # 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->result, 3, '$future->result' ); } { 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->result, 3, '$future->result' ); } # 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; Future-0.48/t/33utils-repeat-generate.t000444001750001750 312614174113203 16577 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result, "result", '$future->result' ); } # 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->result, "ignore me 3", '$last_trial_f->result' ); $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; Future-0.48/t/34utils-repeat-foreach.t000444001750001750 772514174113203 16426 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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->result, "result", '$future->result' ); } # 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->result, "ignore me three", '$last_trial_f->result' ); $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->result ], [], '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->result ], [ 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->result, "good", '$future->result 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->result, "good", '$future->result returns correct result for foreach+until' ); } # foreach while + otherwise { my $future = repeat { Future->done( $_[0] ); } foreach => [ 1, 2, 3 ], while => sub { $_[0]->result < 2 }, otherwise => sub { Future->fail( "Failed to find 2" ) }; is( scalar $future->result, 2, '$future->result 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->result, "good", '$future->result 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; Future-0.48/t/35utils-map-void.t000444001750001750 1200014174113203 15254 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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 { is( $_, $_[0], 'item passed in $_ as well as @_' ); 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->result ], [], '$future->result 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; Future-0.48/t/36utils-map.t000444001750001750 437614174113203 14317 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Test::Fatal; 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->result ], [qw( A B C D E )], '$future->result 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->result ], [qw( A B C D E )], '$future->result for fmap_concat out of order' ); } # fmap_concat concurrent above input { my @subf; my $future = fmap_concat { return $subf[$_[0]] = Future->new; } foreach => [ 0 .. 2 ], concurrent => 5; $subf[0]->done( "A" ); $subf[1]->done( "B" ); $subf[2]->done( "C" ); is_deeply( [ $future->result ], [qw( A B C )], '$future->result for fmap_concat concurrent more than input' ); } # fmap_concat cancel { my $f = Future->new; my $fmap = fmap_concat { $f } foreach => [ $f ], concurrent => 2; is( exception { $fmap->cancel }, undef, '$fmap_concat->cancel does not throw on undef slots' ); ok( $fmap->is_cancelled, 'was cancelled correctly' ); } # 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->result ], [qw( A B C )], '$future->result for fmap_scalar' ); is_deeply( \@results, [qw( A B C )], '@results for fmap_scalar' ); } done_testing; Future-0.48/t/40mutex.t000444001750001750 1121314174113203 13545 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Test::Refcount; use Future; use Future::Mutex; # done { my $mutex = Future::Mutex->new; ok( $mutex->available, 'Mutex is available' ); my $f; my $lf = $mutex->enter( sub { $f = t::Future::Subclass->new } ); ok( defined $lf, '->enter returns Future' ); ok( defined $f, '->enter on new Mutex runs code' ); isa_ok( $lf, "t::Future::Subclass", '$lf' ); ok( !$mutex->available, 'Mutex is unavailable' ); ok( !$lf->is_ready, 'locked future not yet ready' ); $f->done; ok( $lf->is_ready, 'locked future ready after $f->done' ); ok( $mutex->available, 'Mutex is available again' ); undef $f; is_oneref( $lf, '$lf has one ref at EOT' ); } # done chaining { my $mutex = Future::Mutex->new; my $f1; my $lf1 = $mutex->enter( sub { $f1 = t::Future::Subclass->new } ); my $f2; my $lf2 = $mutex->enter( sub { $f2 = t::Future::Subclass->new } ); isa_ok( $lf1, "t::Future::Subclass", '$lf1' ); isa_ok( $lf2, "t::Future::Subclass", '$lf2' ); is_oneref( $lf2, '$lf2 has one ref' ); ok( !defined $f2, 'second enter not invoked while locked' ); $f1->done; ok( defined $f2, 'second enter invoked after $f1->done' ); $f2->done; ok( $lf2->is_ready, 'second locked future ready after $f2->done' ); ok( $mutex->available, 'Mutex is available again' ); undef $f1; undef $f2; is_oneref( $lf1, '$lf1 has one ref at EOT' ); is_oneref( $lf2, '$lf2 has one ref at EOT' ); } # fail chaining { my $mutex = Future::Mutex->new; my $f1; my $lf1 = $mutex->enter( sub { $f1 = Future->new } ); my $f2; my $lf2 = $mutex->enter( sub { $f2 = Future->new } ); ok( !defined $f2, 'second enter not invoked while locked' ); $f1->fail( "oops" ); ok( defined $f2, 'second enter invoked after $f1->fail' ); ok( $lf1->failure, 'first locked future fails after $f1->fail' ); $f2->done; ok( $lf2->is_ready, 'second locked future ready after $f2->done' ); ok( $mutex->available, 'Mutex is available again' ); } # immediately done { my $mutex = Future::Mutex->new; is( $mutex->enter( sub { Future->done( "result" ) } )->result, "result", '$mutex->enter returns immediate result' ); ok( $mutex->available, 'Mutex is available again' ); } # immediately fail { my $mutex = Future::Mutex->new; is( $mutex->enter( sub { Future->fail( "oops" ) } )->failure, "oops", '$mutex->enter returns immediate failure' ); ok( $mutex->available, 'Mutex is available again' ); } # code dies { my $mutex = Future::Mutex->new; is( $mutex->enter( sub { die "oopsie\n" } )->failure, "oopsie\n", '$mutex->enter returns immediate failure on exception' ); ok( $mutex->available, 'Mutex is available again' ); } # cancellation { my $mutex = Future::Mutex->new; my $f = $mutex->enter( sub { Future->new } ); $f->cancel; ok( $mutex->available, 'Mutex is available after cancel' ); } # queueing { my $mutex = Future::Mutex->new; my ( $f1, $f2, $f3 ); my $f = Future->needs_all( $mutex->enter( sub { $f1 = t::Future::Subclass->new } ), $mutex->enter( sub { $f2 = t::Future::Subclass->new } ), $mutex->enter( sub { $f3 = t::Future::Subclass->new } ), ); isa_ok( $f, "t::Future::Subclass", '$f' ); ok( defined $f1, '$f1 defined' ); $f1->done; ok( defined $f2, '$f2 defined' ); $f2->done; ok( defined $f3, '$f3 defined' ); $f3->done; ok( $f->is_done, 'Chain is done' ); ok( $mutex->available, 'Mutex is available after chain done' ); } # queueing with weakly held intermediates { my $mutex = Future::Mutex->new; my ( $f1, $f2, $f3, $f4 ); my $f = Future->needs_all( $mutex->enter( sub { ( $f1 = Future->new )->then( sub { $f2 = Future->new } ) } ), $mutex->enter( sub { ( $f3 = Future->new )->then( sub { $f4 = Future->new } ) } ), ); $f1->done; $f2->done; $f3->done; $f4->done; ok( $f->is_done, 'Chain is done' ); } # counting { my $mutex = Future::Mutex->new( count => 2 ); is( $mutex->available, 2, 'Mutex has 2 counts available' ); my ( $f1, $f2, $f3 ); my $f = Future->needs_all( $mutex->enter( sub { $f1 = Future->new } ), $mutex->enter( sub { $f2 = Future->new } ), $mutex->enter( sub { $f3 = Future->new } ), ); ok( defined $f1 && defined $f2, '$f1 and $f2 defined with count 2' ); $f1->done; ok( defined $f3, '$f3 defined after $f1 done' ); $f2->done; $f3->done; ok( $f->is_done, 'Chain is done' ); ok( $mutex->available, 'Mutex is available after chain done' ); } done_testing; package t::Future::Subclass; use base qw( Future ); Future-0.48/t/41queue.t000444001750001750 116014174113203 13510 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Future; use Future::Queue; # push before shift { my $queue = Future::Queue->new; $queue->push( "ITEM" ); my $f = $queue->shift; ok( $f->is_done, '$queue->shift already ready' ); is( $f->result, "ITEM", '$queue->shift->result' ); } # shift before push { my $queue = Future::Queue->new; my $f = $queue->shift; ok( !$f->is_done, '$queue->shift not yet ready' ); $queue->push( "ITEM" ); ok( $f->is_done, '$queue->shift now ready after push' ); is( $f->result, "ITEM", '$queue->shift->result' ); } done_testing; Future-0.48/t/50test-future.t000444001750001750 353314174113203 14661 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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; Future-0.48/t/51test-future-deferred.t000444001750001750 127414174113203 16440 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; use Test::Fatal; use Test::Future::Deferred; # done { my $f = Test::Future::Deferred->done_later( "result" ); ok( !$f->is_done, '$f not yet ready' ); is( scalar $f->get, "result", '$f->get yields result anyway' ); } # fail { my $f = Test::Future::Deferred->fail_later( "oops\n" ); ok( !$f->is_failed, '$f not yet ready' ); is( exception { $f->get }, "oops\n", '$f->get throws exception anyway' ); } # failure { my $f = Test::Future::Deferred->fail_later( "oops\n" ); ok( !$f->is_failed, '$f not yet ready' ); is( $f->failure, "oops\n", '$f->failure returns exception anyway' ); } done_testing; Future-0.48/t/52awaitable-future.t000444001750001750 53014174113203 15607 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; use strict; use warnings; use Test::More; eval { require Test::Future::AsyncAwait::Awaitable } or plan skip_all => "No Test::Future::AsyncAwait::Awaitable"; use Future; Test::Future::AsyncAwait::Awaitable::test_awaitable( "Future", class => "Future", cancel => sub { shift->cancel }, ); done_testing; Future-0.48/t/99pod.t000444001750001750 27214174113203 13146 0ustar00leoleo000000000000#!/usr/bin/perl use v5.10; 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();