From 8cc5160aefb2ba3611d1d5d6b12b996227f9da72 Mon Sep 17 00:00:00 2001 From: Lorry Tar Creator Date: Tue, 10 Mar 2015 19:55:44 +0000 Subject: Future-0.32 --- Build.PL | 87 ++ Changes | 273 ++++++ LICENSE | 379 ++++++++ MANIFEST | 37 + META.json | 61 ++ META.yml | 37 + Makefile.PL | 17 + README | 945 ++++++++++++++++++ examples/io-async.pl | 9 + lib/Future.pm | 2200 ++++++++++++++++++++++++++++++++++++++++++ lib/Future/Phrasebook.pod | 500 ++++++++++ lib/Future/Utils.pm | 687 +++++++++++++ lib/Test/Future.pm | 141 +++ t/00use.t | 11 + t/01future.t | 290 ++++++ t/02cancel.t | 131 +++ t/03then.t | 290 ++++++ t/04else.t | 259 +++++ t/05then-else.t | 78 ++ t/06followed_by.t | 197 ++++ t/09transform.t | 75 ++ t/10wait_all.t | 160 +++ t/11wait_any.t | 152 +++ t/12needs_all.t | 147 +++ t/13needs_any.t | 200 ++++ t/20subclass.t | 138 +++ t/21debug.t | 83 ++ t/22wrap_cb.t | 105 ++ t/30utils-call.t | 44 + t/31utils-call-with-escape.t | 70 ++ t/32utils-repeat.t | 188 ++++ t/33utils-repeat-generate.t | 65 ++ t/34utils-repeat-foreach.t | 152 +++ t/35utils-map-void.t | 200 ++++ t/36utils-map.t | 65 ++ t/50test-future.t | 87 ++ t/99pod.t | 11 + 37 files changed, 8571 insertions(+) create mode 100644 Build.PL create mode 100644 Changes create mode 100644 LICENSE create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 examples/io-async.pl create mode 100644 lib/Future.pm create mode 100644 lib/Future/Phrasebook.pod create mode 100644 lib/Future/Utils.pm create mode 100644 lib/Test/Future.pm create mode 100644 t/00use.t create mode 100644 t/01future.t create mode 100644 t/02cancel.t create mode 100644 t/03then.t create mode 100644 t/04else.t create mode 100644 t/05then-else.t create mode 100644 t/06followed_by.t create mode 100644 t/09transform.t create mode 100644 t/10wait_all.t create mode 100644 t/11wait_any.t create mode 100644 t/12needs_all.t create mode 100644 t/13needs_any.t create mode 100644 t/20subclass.t create mode 100644 t/21debug.t create mode 100644 t/22wrap_cb.t create mode 100644 t/30utils-call.t create mode 100644 t/31utils-call-with-escape.t create mode 100644 t/32utils-repeat.t create mode 100644 t/33utils-repeat-generate.t create mode 100644 t/34utils-repeat-foreach.t create mode 100644 t/35utils-map-void.t create mode 100644 t/36utils-map.t create mode 100644 t/50test-future.t create mode 100644 t/99pod.t diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..d3b1d2f --- /dev/null +++ b/Build.PL @@ -0,0 +1,87 @@ +use strict; +use warnings; + +use Module::Build; + +# This version of Future contains an important bugfix around weak references +# in sequence Futures. Unfortunately, a lot of existing CPAN code is known to +# rely on this behaviour, and will break if this module is upgraded. +# +# Abort if any of the following modules are installed at versions less than +# the first known-working version. They must be updated before Future can be +# installed. +my %FIXED = ( + 'IO::Async' => '0.62', + 'IO::Async::SSL' => '0.14', + 'Net::Async::CassandraCQL' => '0.11', + 'Net::Async::FTP' => '0.08', + 'Net::Async::HTTP' => '0.34', + 'Net::Async::WebSocket' => '0.08', +); + +my $printed; +foreach my $module ( sort keys %FIXED ) { + my $needsver = $FIXED{$module}; + ( my $modfile = "$module.pm" ) =~ s{::}{/}g; + + next unless eval { require $modfile }; + next if ( my $instver = $module->VERSION ) >= $needsver; + + print STDERR "Installing this version of Future will fix a bug that the following installed\n". + "modules rely on. You must upgrade these modules to a later version after\n". + "Future is installed, or they will not work correctly.\n\n" unless $printed; + + print STDERR " * $module (installed $instver; need at least $needsver)\n"; + $printed++; +} +print STDERR "\n" if $printed; + +if( $printed and -t STDIN ) { + # Attended update; might as well ask the user to confirm and exit if not + my $reply = Module::Build->prompt( + "Are you still sure you wish to go ahead with this upgrade?\n" . + "[enter 'yes' to continue]: ", + "no" + ); + + die "Aborting install due to broken dependent modules\n" unless $reply =~ m/^y/i; +} + +my $build = Module::Build->new( + module_name => 'Future', + test_requires => { + 'Test::Identity' => 0, + 'Test::Fatal' => 0, + 'Test::More' => '0.88', # done_testing + 'Test::Refcount' => 0, + }, + requires => { + 'perl' => '5.008', # fails on 5.6 smokers; no idea why + 'Carp' => '1.25', # new message format with trailing period + 'Test::Builder::Module' => 0, + 'Time::HiRes' => 0, + }, + meta_merge => { + # It's unlikely at the time of writing that any CPAN client actually + # pays attention to this field, but it's nice to declare it on CPAN + # anyway so people will know I want to use it; maybe one day clients + # will follow it... + x_breaks => { do { + map { $_ => "< $FIXED{$_}" } keys %FIXED + }}, + }, + configure_requires => { + 'Module::Build' => '0.4004', # test_requires + }, + license => 'perl', + create_makefile_pl => 'traditional', + create_license => 1, + create_readme => 1, + meta_merge => { + resources => { + x_IRC => "irc://irc.perl.org/#io-async", + }, + }, +); + +$build->create_build_script; diff --git a/Changes b/Changes new file mode 100644 index 0000000..59a3f2b --- /dev/null +++ b/Changes @@ -0,0 +1,273 @@ +Revision history for Future + +0.32 2015/03/10 19:54:22 + [CHANGES] + * Documentation updates for new ->wrap_cb method + + [BUGFIXES] + * Empty convergents should respect subclassing (RT97537) + * Adjust loss-report regexp for bleadperl (RT99002 again) + * Make trailing periods in warning tests optional, to account for + Carp version changes (RT100685) + +0.31 2015/03/08 17:50:06 + [CHANGES] + * Added debugging warning when destroying a failed Future that has + not reported its failure (RT102198) + * Have ->and_then / ->or_else die immediately to further their + deprecation + * Announce done_cb/fail_cb/cancel_cb as deprecated in favour of curry + * Provide ->wrap_cb method (experimental) + + [BUGFIXES] + * Ensure that Test::Future does not retain Futures once they are + complete (RT101128) + * 'use Future' in Future::Utils (RT102167) + +0.30 2014/11/26 14:29:28 + [CHANGES] + * Rename 'dependent' futures to 'convergent' + * Removed examples/ scripts that now exist as independent modules + * Added ->without_cancel + * Sanity-check the $code argument to ->on_{ready,done,fail,cancel} to + ensure it is callable or a Future + + [BUGFIXES] + * Ensure that 'ready_at' is always set in DEBUG mode + * Fix DEBUG 'lost_at' line number reporting tests for latest + bleadperl (RT99002) + * Ensure that if Future::Utils::repeat condition code dies, that is + passed to the result Future and not propagated to the caller + (RT100067) + * Failure by returning a non-Future from a sequencing code block + should report as a failed Future, not throw exception to caller + +0.29 2014/07/17 12:18:12 + [CHANGES] + * Added Test::Future + * Stronger deprecations - repeat {} on failures warns every time, + ->and_then / ->or_else warn once + + [BUGFIXES] + * Define the behaviour of dependent futures when components are + cancelled. (Partially fixes RT96685) + * Use Module::Build->prompt (RT96409) + * Ensure that repeat on an empty foreach list or empty generator + without 'otherwise' behaves correctly, just yield an immediate + +0.28 2014/06/08 22:43:40 + [CHANGES] + * Added ->label + * Added ->btime, rtime, elapsed tracing timers + * Better handling of 'breaks' version detection + +0.27 2014/06/06 17:42:27 + [BUGFIXES] + * Depend on Carp 1.25 for the new message format with trailing + period, so tests work + +0.26 2014/06/01 12:52:53 + [CHANGES] + * Added ->is_failed accessor + * Implement ->export_to_level in Future::Utils + * Print a warning about lost sequence Futures + * Allow Future->done and Future->fail as simple class constructors + to return immediates + * Added Future->unwrap + + [BUGFIXES] + * Ensure that sequence futures are weaken()ed in the forward + direction. + **NOTE** This will potentially break existing code that depended on + strong references. This old code was, however, broken. + +0.25 2014/02/22 03:47:08 + [BUGFIXES] + * Fix warning-matching test in unit test for both older and newer + versions of Carp + +0.24 2014/02/21 17:57:49 + [CHANGES] + * Have repeat print a warning if it is asked to retry over a failure + * Change documentation to suggest try_repeat instead of repeat for + retries over failure + * Check at call time that sequencing callbacks really are callable, + leading to neater error messages (RT93164) + +0.23 2014/01/19 15:26:55 + [CHANGES] + * Link to Futures advent calendar 2013 + * Fixes/additions to Phrasebook documentation, including section + about tree recursion + + [BUGFIXES] + * Ensure that late addition of additional items to a fmap foreach + array works correctly even with concurrency + +0.22 2014/01/12 03:12:18 + [CHANGES] + * Ignore ->done or ->fail on cancelled Futures + * Added ->then_done, ->then_fail, ->else_done, ->else_fail + * Neaten up naming of fmap* family - provide both long and short + names for each function + * Added Future::Utils::call and call_with_escape + * Ensure that dependent futures on subclasses tries to use derived + futures as prototype if possible + +0.21 2013/12/29 18:14:41 + [CHANGES] + * Major performance improvement by folding out some layers of sub {} + wrapping in sequencing operations + * Added ->then_with_f and ->else_with_f + + [BUGFIXES] + * Don't start another trial after cancelling a repeat() (RT91147) + +0.20 2013/11/18 19:14:27 + [CHANGES] + * Include an indication of done/failed/cancelled status of a Future + when ->done or ->failing an already-ready one + + [BUGFIXES] + * Declare requires perl 5.8 because it fails on 5.6 smokers - no idea + why + * Fix a couple of typoes in docs (RT89185) + +0.19 2013/09/27 13:31:16 + [BUGFIXES] + * Guard against odd things happening during ->cancel at global + destruction (RT88967) + +0.18 2013/09/20 19:09:57 + [CHANGES] + * Added 'try_repeat' and 'try_repeat_until_success' aliases + * @CARP_NOT trust between Future and Future::Utils + + [BUGFIXES] + * Fix to concurrent non-immediate + immediate fmap* return values + +0.17 2013/09/07 16:53:47 + [CHANGES] + * Performance improvement by using direct member access instead of + accessor methods + * Documentation updates; suggestion of documentation style for + Future-returning code + + [BUGFIXES] + * Respect subclassing of immediate->followed_by and dependent futures + with mixed subclass or immediate components + +0.16 CHANGES: + * Proper behaviour of ->wait_all and ->needs_all on an empty list - + just return empty immediate done + * Proper behaviour of ->wait_any and ->needs_any on an empty list - + return an immediate failure + * Performance improvement to ->done for immediate Future->new->done + * Keep a count of pending child futures to avoid quadratic behaviour + due to linear scan of children every time one completes + * Improve efficiency of Future::Utils::repeat and fmap* when trials + return immediates + * Make repeat and fmap* 'return' argument optional by cloning the + first non-immediate trial + * Rework unit tests to avoid dependency on Test::Warn + +0.15 CHANGES: + * Added Future->call constructor + * Fixed reference-retaining bug in Future's on_cancel callback list + * Ensure that ->cancel returns $self even on immediates + * Documentation updates to mention ->wrap and ->call, and the fmap + family + +0.14 CHANGES: + * Added Future->wrap constructor + * Added Future::Utils::fmap* family of functions + + BUGFIXES: + * Fixed a precedence bug in 'and' vs && + +0.13 CHANGES: + * Added ->then and ->else methods; like ->and_then but code is passed + result directly instead of invocant future + * Added repeat { ... } foreach, otherwise argument to set final + result and also handle empty lists + * Added repeat { ... } generate + * Turn repeat { ... } code block exceptions into failed futures + * Ensure that ->on_cancel returns $self (RT85134) + * Documentation / Phrasebook updates to demonstrate newly added + features + +0.12 CHANGES: + * Take a 'return' argument to Future::Utils::repeat; deprecate the + trial-cloning feature for subclasses + * Have ->followed_by/etc... print a warning in void context + * Throw an exception when ->followed_by/etc.. code does not yield a + Future (RT84188) + * Ensure that ->needs_all/->needs_any work correctly on a mix of + immediate and pending Futures (RT84187) + * Ensure that ->on_done/->on_fail always return invocant (RT84313) + * Ensure that ->on_ready($f) works on cancelled Futures (RT84312) + +0.11 CHANGES: + * Added Future::Phrasebook documentation file + * Ensure that exceptions thrown from ->followed_by code block are + caught and turned into failed Futures + * Fix filename regexp matches for unit-tests so they work on Windows + +0.10 BUGFIXES: + * Account for newer Carp version in unit tests, which appends + trailing period to messages + +0.09 CHANGES: + * Split ->fail method into new ->die call, only append caller + file/line to the exception in the latter + * Various documentation and example improvements + +0.08 CHANGES: + * Ignore attempts to cancel already-complete or already-cancelled + futures, or to attach ->on_cancel callbacks to them + * $future->get should return the first result in scalar context + * Added Future::Utils with repeat { ...} and + repeat_until_success { ... } looping constructs + + * Link to LPW2012 talk slides + +0.07 CHANGES: + * Leak debugging + +0.06 CHANGES: + * Remembered to actually include the example scripts. No other actual + code changes. + +0.05 CHANGES: + * Respect subclassing by allowing ->new on instances + * Allow subclasses to provide an ->await method which will be used + by ->get and ->failure + * Added some example scripts to demonstrate how to use Futures with + various event systems + +0.04 CHANGES: + * Fix implementation of sequenced futures to work properly on + immediates + * Ensure that future->future chaining via callbacks works correctly + on immediates + * Link to "curry" in the docs about CODE-returning convenience + accessors ->done_cb, ->fail_cb and ->cancel_cb + +0.03 INCOMPATIBLE CHANGES: + * Future->needs_all and Future->needs_any now return dependents' + results + + CHANGES: + * Removed $future->( ... ) callable override + * Pass $f1 to ->or_else code block by symmetry with ->and_then + * Added $f->followed_by + * Added Future->wait_any dependent future constructor + * Rearranged documentation and added more examples + +0.02 CHANGES: + * Rearranged non-leaf future logic + * Added {pending,ready,done,failed,cancelled}_futures accessors + * Added Future->needs_any constructor + +0.01 First version, released on an unsuspecting world. + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..94306ca --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2015 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) 2015 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) 2015 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 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..d44f938 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,37 @@ +Build.PL +Changes +examples/io-async.pl +lib/Future.pm +lib/Future/Phrasebook.pod +lib/Future/Utils.pm +lib/Test/Future.pm +LICENSE +Makefile.PL +MANIFEST This list of files +META.json +META.yml +README +t/00use.t +t/01future.t +t/02cancel.t +t/03then.t +t/04else.t +t/05then-else.t +t/06followed_by.t +t/09transform.t +t/10wait_all.t +t/11wait_any.t +t/12needs_all.t +t/13needs_any.t +t/20subclass.t +t/21debug.t +t/22wrap_cb.t +t/30utils-call.t +t/31utils-call-with-escape.t +t/32utils-repeat.t +t/33utils-repeat-generate.t +t/34utils-repeat-foreach.t +t/35utils-map-void.t +t/36utils-map.t +t/50test-future.t +t/99pod.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..d6429b8 --- /dev/null +++ b/META.json @@ -0,0 +1,61 @@ +{ + "abstract" : "represent an operation awaiting completion", + "author" : [ + "Paul Evans " + ], + "dynamic_config" : 1, + "generated_by" : "Module::Build version 0.421", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Future", + "prereqs" : { + "configure" : { + "requires" : { + "Module::Build" : "0.4004" + } + }, + "runtime" : { + "requires" : { + "Carp" : "1.25", + "Test::Builder::Module" : "0", + "Time::HiRes" : "0", + "perl" : "5.008" + } + }, + "test" : { + "requires" : { + "Test::Fatal" : "0", + "Test::Identity" : "0", + "Test::More" : "0.88", + "Test::Refcount" : "0" + } + } + }, + "provides" : { + "Future" : { + "file" : "lib/Future.pm", + "version" : "0.32" + }, + "Future::Utils" : { + "file" : "lib/Future/Utils.pm", + "version" : "0.32" + }, + "Test::Future" : { + "file" : "lib/Test/Future.pm", + "version" : "0.32" + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/" + ], + "x_IRC" : "irc://irc.perl.org/#io-async" + }, + "version" : "0.32" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..cb38c9a --- /dev/null +++ b/META.yml @@ -0,0 +1,37 @@ +--- +abstract: 'represent an operation awaiting completion' +author: + - 'Paul Evans ' +build_requires: + Test::Fatal: '0' + Test::Identity: '0' + Test::More: '0.88' + Test::Refcount: '0' +configure_requires: + Module::Build: '0.4004' +dynamic_config: 1 +generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.142690' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Future +provides: + Future: + file: lib/Future.pm + version: '0.32' + Future::Utils: + file: lib/Future/Utils.pm + version: '0.32' + Test::Future: + file: lib/Test/Future.pm + version: '0.32' +requires: + Carp: '1.25' + Test::Builder::Module: '0' + Time::HiRes: '0' + perl: '5.008' +resources: + IRC: irc://irc.perl.org/#io-async + license: http://dev.perl.org/licenses/ +version: '0.32' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..153cfbb --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,17 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.4210 +require 5.008; +use ExtUtils::MakeMaker; +WriteMakefile +( + 'NAME' => 'Future', + 'VERSION_FROM' => 'lib/Future.pm', + 'PREREQ_PM' => { + 'Carp' => '1.25', + 'Test::Builder::Module' => 0, + 'Time::HiRes' => 0 + }, + 'INSTALLDIRS' => 'site', + 'EXE_FILES' => [], + 'PL_FILES' => {} +) +; diff --git a/README b/README new file mode 100644 index 0000000..9f193f0 --- /dev/null +++ b/README @@ -0,0 +1,945 @@ +NAME + `Future' - represent an operation awaiting completion + +SYNOPSIS + my $future = Future->new; + + perform_some_operation( + on_complete => sub { + $future->done( @_ ); + } + ); + + $future->on_ready( sub { + say "The operation is complete"; + } ); + +DESCRIPTION + A `Future' object represents an operation that is currently in progress, + or has recently completed. It can be used in a variety of ways to manage + the flow of control, and data, through an asynchronous program. + + Some futures represent a single operation and are explicitly marked as + ready by calling the `done' or `fail' methods. These are called "leaf" + futures here, and are returned by the `new' constructor. + + Other futures represent a collection of sub-tasks, and are implicitly + marked as ready depending on the readiness of their component futures as + required. These are called "convergent" futures here as they converge + control and data-flow back into one place. These are the ones returned + by the various `wait_*' and `need_*' constructors. + + It is intended that library functions that perform asynchronous + operations would use future objects to represent outstanding operations, + and allow their calling programs to control or wait for these operations + to complete. The implementation and the user of such an interface would + typically make use of different methods on the class. The methods below + are documented in two sections; those of interest to each side of the + interface. + + It should be noted however, that this module does not in any way provide + an actual mechanism for performing this asynchronous activity; it merely + provides a way to create objects that can be used for control and data + flow around those operations. It allows such code to be written in a + neater, forward-reading manner, and simplifies many common patterns that + are often involved in such situations. + + See also Future::Utils which contains useful loop-constructing + functions, to run a future-returning function repeatedly in a loop. + + SUBCLASSING + This class easily supports being subclassed to provide extra behavior, + such as giving the `get' method the ability to block and wait for + completion. This may be useful to provide `Future' subclasses with event + systems, or similar. + + Each method that returns a new future object will use the invocant to + construct its return value. If the constructor needs to perform + per-instance setup it can override the `new' method, and take context + from the given instance. + + sub new + { + my $proto = shift; + my $self = $proto->SUPER::new; + + if( ref $proto ) { + # Prototype was an instance + } + else { + # Prototype was a class + } + + return $self; + } + + If an instance provides a method called `await', this will be called by + the `get' and `failure' methods if the instance is pending. + + $f->await + + In most cases this should allow future-returning modules to be used as + if they were blocking call/return-style modules, by simply appending a + `get' call to the function or method calls. + + my ( $results, $here ) = future_returning_function( @args )->get; + + The examples directory in the distribution contains some examples of how + futures might be integrated with various event systems. + + MODULE DOCUMENTATION + Modules that provide future-returning functions or methods may wish to + adopt the following styles in some way, to document the eventual return + values from these futures. + + func( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + OBJ->method( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + Code returning a future that yields no values on success can use empty + parentheses. + + func( ... ) ==> () + + DEBUGGING + By the time a `Future' object is destroyed, it ought to have been + completed or cancelled. By enabling debug tracing of objects, this fact + can be checked. If a future object is destroyed without having been + completed or cancelled, a warning message is printed. + + $ PERL_FUTURE_DEBUG=1 perl -MFuture -E 'my $f = Future->new' + Future=HASH(0xaa61f8) was constructed at -e line 1 and was lost near -e line 0 before it was ready. + + Note that due to a limitation of perl's `caller' function within a + `DESTROY' destructor method, the exact location of the leak cannot be + accurately determined. Often the leak will occur due to falling out of + scope by returning from a function; in this case the leak location may + be reported as being the line following the line calling that function. + + $ PERL_FUTURE_DEBUG=1 perl -MFuture + sub foo { + my $f = Future->new; + } + + foo(); + print "Finished\n"; + + Future=HASH(0x14a2220) was constructed at - line 2 and was lost near - line 6 before it was ready. + Finished + + A warning is also printed in debug mode if a `Future' object is + destroyed that completed with a failure, but the object believes that + failure has not been reported anywhere. + + $ PERL_FUTURE_DEBUG=1 perl -Mblib -MFuture -E 'my $f = Future->fail("Oops")' + Future=HASH(0xac98f8) was constructed at -e line 1 and was lost near -e line 0 with an unreported failure of: Oops + + Such a failure is considered reported if the `get' or `failure' methods + are called on it, or it had at least one `on_ready' or `on_fail' + callback, or its failure is propagated to another `Future' instance (by + a sequencing or converging method). + +CONSTRUCTORS + $future = Future->new + $future = $orig->new + Returns a new `Future' instance to represent a leaf future. It will be + marked as ready by any of the `done', `fail', or `cancel' methods. It + can be called either as a class method, or as an instance method. Called + on an instance it will construct another in the same class, and is + useful for subclassing. + + This constructor would primarily be used by implementations of + asynchronous interfaces. + + $future = Future->done( @values ) + $future = Future->fail( $exception, @details ) + Shortcut wrappers around creating a new `Future' then immediately + marking it as done or failed. + + $future = Future->wrap( @values ) + If given a single argument which is already a `Future' reference, this + will be returned unmodified. Otherwise, returns a new `Future' instance + that is already complete, and will yield the given values. + + This will ensure that an incoming argument is definitely a `Future', and + may be useful in such cases as adapting synchronous code to fit + asynchronous libraries driven by `Future'. + + $future = Future->call( \&code, @args ) + A convenient wrapper for calling a `CODE' reference that is expected to + return a future. In normal circumstances is equivalent to + + $future = $code->( @args ) + + except that if the code throws an exception, it is wrapped in a new + immediate fail future. If the return value from the code is not a + blessed `Future' reference, an immediate fail future is returned instead + to complain about this fact. + +IMPLEMENTATION METHODS + These methods would primarily be used by implementations of asynchronous + interfaces. + + $future->done( @result ) + Marks that the leaf future is now ready, and provides a list of values + as a result. (The empty list is allowed, and still indicates the future + as ready). Cannot be called on a convergent future. + + If the future is already cancelled, this request is ignored. If the + future is already complete with a result or a failure, an exception is + thrown. + + Future->done( @result ) + May also be called as a class method, where it will construct a new + Future and immediately mark it as done. + + Returns the `$future' to allow easy chaining to create an immediate + future by + + return Future->done( ... ) + + $code = $future->done_cb + Returns a `CODE' reference that, when invoked, calls the `done' method. + This makes it simple to pass as a callback function to other code. + + As the same effect can be achieved using curry, this method is + deprecated now and may be removed in a later version. + + $code = $future->curry::done; + + $future->fail( $exception, @details ) + Marks that the leaf future has failed, and provides an exception value. + This exception will be thrown by the `get' method if called. + + The exception must evaluate as a true value; false exceptions are not + allowed. Further details may be provided that will be returned by the + `failure' method in list context. These details will not be part of the + exception string raised by `get'. + + If the future is already cancelled, this request is ignored. If the + future is already complete with a result or a failure, an exception is + thrown. + + Future->fail( $exception, @details ) + May also be called as a class method, where it will construct a new + Future and immediately mark it as failed. + + Returns the `$future' to allow easy chaining to create an immediate + failed future by + + return Future->fail( ... ) + + $code = $future->fail_cb + Returns a `CODE' reference that, when invoked, calls the `fail' method. + This makes it simple to pass as a callback function to other code. + + As the same effect can be achieved using curry, this method is + deprecated now and may be removed in a later version. + + $code = $future->curry::fail; + + $future->die( $message, @details ) + A convenient wrapper around `fail'. If the exception is a non-reference + that does not end in a linefeed, its value will be extended by the file + and line number of the caller, similar to the logic that `die' uses. + + Returns the `$future'. + + $future->on_cancel( $code ) + If the future is not yet ready, adds a callback to be invoked if the + future is cancelled by the `cancel' method. If the future is already + ready, throws an exception. + + If the future is cancelled, the callbacks will be invoked in the reverse + order to that in which they were registered. + + $on_cancel->( $future ) + + $future->on_cancel( $f ) + If passed another `Future' instance, the passed instance will be + cancelled when the original future is cancelled. This method does + nothing if the future is already complete. + + $cancelled = $future->is_cancelled + Returns true if the future has been cancelled by `cancel'. + +USER METHODS + These methods would primarily be used by users of asynchronous + interfaces, on objects returned by such an interface. + + $ready = $future->is_ready + Returns true on a leaf future if a result has been provided to the + `done' method, failed using the `fail' method, or cancelled using the + `cancel' method. + + Returns true on a convergent future if it is ready to yield a result, + depending on its component futures. + + $future->on_ready( $code ) + If the future is not yet ready, adds a callback to be invoked when the + future is ready. If the future is already ready, invokes it immediately. + + In either case, the callback will be passed the future object itself. + The invoked code can then obtain the list of results by calling the + `get' method. + + $on_ready->( $future ) + + Returns the `$future'. + + $future->on_ready( $f ) + If passed another `Future' instance, the passed instance will have its + `done', `fail' or `cancel' methods invoked when the original future + completes successfully, fails, or is cancelled respectively. + + $done = $future->is_done + Returns true on a future if it is ready and completed successfully. + Returns false if it is still pending, failed, or was cancelled. + + @result = $future->get + $result = $future->get + If the future is ready and completed successfully, returns the list of + results that had earlier been given to the `done' method on a leaf + future, or the list of component futures it was waiting for on a + convergent future. In scalar context it returns just the first result + value. + + If the future is ready but failed, this method raises as an exception + the failure string or object that was given to the `fail' method. + + If the future was cancelled an exception is thrown. + + If it is not yet ready and is not of a subclass that provides an `await' + method an exception is thrown. If it is subclassed to provide an `await' + method then this is used to wait for the future to be ready, before + returning the result or propagating its failure exception. + + @values = Future->unwrap( @values ) + If given a single argument which is a `Future' reference, this method + will call `get' on it and return the result. Otherwise, it returns the + list of values directly in list context, or the first value in scalar. + Since it involves an implicit `await', this method can only be used on + immediate futures or subclasses that implement `await'. + + This will ensure that an outgoing argument is definitely not a `Future', + and may be useful in such cases as adapting synchronous code to fit + asynchronous libraries that return `Future' instances. + + $future->on_done( $code ) + If the future is not yet ready, adds a callback to be invoked when the + future is ready, if it completes successfully. If the future completed + successfully, invokes it immediately. If it failed or was cancelled, it + is not invoked at all. + + The callback will be passed the result passed to the `done' method. + + $on_done->( @result ) + + Returns the `$future'. + + $future->on_done( $f ) + If passed another `Future' instance, the passed instance will have its + `done' method invoked when the original future completes successfully. + + $failed = $future->is_failed + Returns true on a future if it is ready and it failed. Returns false if + it is still pending, completed successfully, or was cancelled. + + $exception = $future->failure + $exception, @details = $future->failure + Returns the exception passed to the `fail' method, `undef' if the future + completed successfully via the `done' method, or raises an exception if + called on a future that is not yet ready. + + If called in list context, will additionally yield a list of the details + provided to the `fail' method. + + Because the exception value must be true, this can be used in a simple + `if' statement: + + if( my $exception = $future->failure ) { + ... + } + else { + my @result = $future->get; + ... + } + + $future->on_fail( $code ) + If the future is not yet ready, adds a callback to be invoked when the + future is ready, if it fails. If the future has already failed, invokes + it immediately. If it completed successfully or was cancelled, it is not + invoked at all. + + The callback will be passed the exception and details passed to the + `fail' method. + + $on_fail->( $exception, @details ) + + Returns the `$future'. + + $future->on_fail( $f ) + If passed another `Future' instance, the passed instance will have its + `fail' method invoked when the original future fails. + + To invoke a `done' method on a future when another one fails, use a CODE + reference: + + $future->on_fail( sub { $f->done( @_ ) } ); + + $future->cancel + Requests that the future be cancelled, immediately marking it as ready. + This will invoke all of the code blocks registered by `on_cancel', in + the reverse order. When called on a convergent future, all its component + futures are also cancelled. It is not an error to attempt to cancel a + future that is already complete or cancelled; it simply has no effect. + + Returns the `$future'. + + $code = $future->cancel_cb + Returns a `CODE' reference that, when invoked, calls the `cancel' + method. This makes it simple to pass as a callback function to other + code. + + As the same effect can be achieved using curry, this method is + deprecated now and may be removed in a later version. + + $code = $future->curry::cancel; + +SEQUENCING METHODS + The following methods all return a new future to represent the + combination of its invocant followed by another action given by a code + reference. The combined activity waits for the first future to be ready, + then may invoke the code depending on the success or failure of the + first, or may run it regardless. The returned sequence future represents + the entire combination of activity. + + In some cases the code should return a future; in some it should return + an immediate result. If a future is returned, the combined future will + then wait for the result of this second one. If the combinined future is + cancelled, it will cancel either the first future or the second, + depending whether the first had completed. If the code block throws an + exception instead of returning a value, the sequence future will fail + with that exception as its message and no further values. + + As it is always a mistake to call these sequencing methods in void + context and lose the reference to the returned future (because + exception/error handling would be silently dropped), this method warns + in void context. + + $future = $f1->then( \&done_code ) + Returns a new sequencing `Future' that runs the code if the first + succeeds. Once `$f1' succeeds the code reference will be invoked and is + passed the list of results. It should return a future, `$f2'. Once `$f2' + completes the sequence future will then be marked as complete with + whatever result `$f2' gave. If `$f1' fails then the sequence future will + immediately fail with the same failure and the code will not be invoked. + + $f2 = $done_code->( @result ) + + $future = $f1->else( \&fail_code ) + Returns a new sequencing `Future' that runs the code if the first fails. + Once `$f1' fails the code reference will be invoked and is passed the + failure and details. It should return a future, `$f2'. Once `$f2' + completes the sequence future will then be marked as complete with + whatever result `$f2' gave. If `$f1' succeeds then the sequence future + will immediately succeed with the same result and the code will not be + invoked. + + $f2 = $fail_code->( $exception, @details ) + + $future = $f1->then( \&done_code, \&fail_code ) + The `then' method can also be passed the `$fail_code' block as well, + giving a combination of `then' and `else' behaviour. + + This operation is designed to be compatible with the semantics of other + future systems, such as Javascript's Q or Promises/A libraries. + + $future = $f1->transform( %args ) + Returns a new sequencing `Future' that wraps the one given as `$f1'. + With no arguments this will be a trivial wrapper; `$future' will + complete or fail when `$f1' does, and `$f1' will be cancelled when + `$future' is. + + By passing the following named arguments, the returned `$future' can be + made to behave differently to `$f1': + + done => CODE + Provides a function to use to modify the result of a successful + completion. When `$f1' completes successfully, the result of its + `get' method is passed into this function, and whatever it + returns is passed to the `done' method of `$future' + + fail => CODE + Provides a function to use to modify the result of a failure. + When `$f1' fails, the result of its `failure' method is passed + into this function, and whatever it returns is passed to the + `fail' method of `$future'. + + $future = $f1->then_with_f( \&code ) + Returns a new sequencing `Future' that runs the code if the first + succeeds. Identical to `then', except that the code reference will be + passed both the original future, `$f1', and its result. + + $f2 = $code->( $f1, @result ) + + This is useful for conditional execution cases where the code block may + just return the same result of the original future. In this case it is + more efficient to return the original future itself. + + $future = $f->then_done( @result ) + $future = $f->then_fail( $exception, @details ) + Convenient shortcuts to returning an immediate future from a `then' + block, when the result is already known. + + $future = $f1->else_with_f( \&code ) + Returns a new sequencing `Future' that runs the code if the first fails. + Identical to `else', except that the code reference will be passed both + the original future, `$f1', and its exception and details. + + $f2 = $code->( $f1, $exception, @details ) + + This is useful for conditional execution cases where the code block may + just return the same result of the original future. In this case it is + more efficient to return the original future itself. + + $future = $f->else_done( @result ) + $future = $f->else_fail( $exception, @details ) + Convenient shortcuts to returning an immediate future from a `else' + block, when the result is already known. + + $future = $f1->followed_by( \&code ) + Returns a new sequencing `Future' that runs the code regardless of + success or failure. Once `$f1' is ready the code reference will be + invoked and is passed one argument, `$f1'. It should return a future, + `$f2'. Once `$f2' completes the sequence future will then be marked as + complete with whatever result `$f2' gave. + + $f2 = $code->( $f1 ) + + $future = $f1->without_cancel + Returns a new sequencing `Future' that will complete with the success or + failure of the original future, but if cancelled, will not cancel the + original. This may be useful if the original future represents an + operation that is being shared among multiple sequences; cancelling one + should not prevent the others from running too. + +CONVERGENT FUTURES + The following constructors all take a list of component futures, and + return a new future whose readiness somehow depends on the readiness of + those components. The first derived class component future will be used + as the prototype for constructing the return value, so it respects + subclassing correctly, or failing that a plain `Future'. + + $future = Future->wait_all( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once all + of the sub future objects given to it indicate that they are ready, + either by success, failure or cancellation. Its result will a list of + its component futures. + + When given an empty list this constructor returns a new immediately-done + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + + $future = Future->wait_any( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once any + of the sub future objects given to it indicate that they are ready, + either by success or failure. Any remaining component futures that are + not yet ready will be cancelled. Its result will be the result of the + first component future that was ready; either success or failure. Any + component futures that are cancelled are ignored, apart from the final + component left; at which point the result will be a failure. + + When given an empty list this constructor returns an immediately-failed + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + + $future = Future->needs_all( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once all + of the sub future objects given to it indicate that they have completed + successfully, or when any of them indicates that they have failed. If + any sub future fails, then this will fail immediately, and the remaining + subs not yet ready will be cancelled. Any component futures that are + cancelled will cause an immediate failure of the result. + + If successful, its result will be a concatenated list of the results of + all its component futures, in corresponding order. If it fails, its + failure will be that of the first component future that failed. To + access each component future's results individually, use `done_futures'. + + When given an empty list this constructor returns a new immediately-done + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + + $future = Future->needs_any( @subfutures ) + Returns a new `Future' instance that will indicate it is ready once any + of the sub future objects given to it indicate that they have completed + successfully, or when all of them indicate that they have failed. If any + sub future succeeds, then this will succeed immediately, and the + remaining subs not yet ready will be cancelled. Any component futures + that are cancelled are ignored, apart from the final component left; at + which point the result will be a failure. + + If successful, its result will be that of the first component future + that succeeded. If it fails, its failure will be that of the last + component future to fail. To access the other failures, use + `failed_futures'. + + Normally when this future completes successfully, only one of its + component futures will be done. If it is constructed with multiple that + are already done however, then all of these will be returned from + `done_futures'. Users should be careful to still check all the results + from `done_futures' in that case. + + When given an empty list this constructor returns an immediately-failed + future. + + This constructor would primarily be used by users of asynchronous + interfaces. + +METHODS ON CONVERGENT FUTURES + The following methods apply to convergent (i.e. non-leaf) futures, to + access the component futures stored by it. + + @f = $future->pending_futures + @f = $future->ready_futures + @f = $future->done_futures + @f = $future->failed_futures + @f = $future->cancelled_futures + Return a list of all the pending, ready, done, failed, or cancelled + component futures. In scalar context, each will yield the number of such + component futures. + +TRACING METHODS + $future = $future->set_label( $label ) + $label = $future->label + Chaining mutator and accessor for the label of the `Future'. This should + be a plain string value, whose value will be stored by the future + instance for use in debugging messages or other tooling, or similar + purposes. + + [ $sec, $usec ] = $future->btime + [ $sec, $usec ] = $future->rtime + Accessors that return the tracing timestamps from the instance. These + give the time the instance was contructed ("birth" time, `btime') and + the time the result was determined (the "ready" time, `rtime'). Each + result is returned as a two-element ARRAY ref, containing the epoch time + in seconds and microseconds, as given by `Time::HiRes::gettimeofday'. + + In order for these times to be captured, they have to be enabled by + setting `$Future::TIMES' to a true value. This is initialised true at + the time the module is loaded if either `PERL_FUTURE_DEBUG' or + `PERL_FUTURE_TIMES' are set in the environment. + + $sec = $future->elapsed + If both tracing timestamps are defined, returns the number of seconds of + elapsed time between them as a floating-point number. If not, returns + `undef'. + + $cb = $future->wrap_cb( $operation_name, $cb ) + *Since version 0.31.* + + *Note: This method is experimental and may be changed or removed in a + later version.* + + This method is invoked internally by various methods that are about to + save a callback CODE reference supplied by the user, to be invoked + later. The default implementation simply returns the callback agument + as-is; the method is provided to allow users to provide extra behaviour. + This can be done by applying a method modifier of the `around' kind, so + in effect add a chain of wrappers. Each wrapper can then perform its own + wrapping logic of the callback. `$operation_name' is a string giving the + reason for which the callback is being saved; currently one of + `on_ready', `on_done', `on_fail' or `sequence'; the latter being used + for all the sequence-returning methods. + + This method is intentionally invoked only for CODE references that are + being saved on a pending `Future' instance to be invoked at some later + point. It does not run for callbacks to be invoked on an + already-complete instance. This is for performance reasons, where the + intended behaviour is that the wrapper can provide some amount of + context save and restore, to return the operating environment for the + callback back to what it was at the time it was saved. + + For example, the following wrapper saves the value of a package variable + at the time the callback was saved, and restores that value at + invocation time later on. This could be useful for preserving context + during logging in a Future-based program. + + our $LOGGING_CTX; + + no warnings 'redefine'; + + my $orig = Future->can( "wrap_cb" ); + *Future::wrap_cb = sub { + my $cb = $orig->( @_ ); + + my $saved_logging_ctx = $LOGGING_CTX; + + return sub { + local $LOGGING_CTX = $saved_logging_ctx; + $cb->( @_ ); + }; + }; + + At this point, any code deferred into a `Future' by any of its callbacks + will observe the `$LOGGING_CTX' variable as having the value it held at + the time the callback was saved, even if it is invoked later on when + that value is different. + + Remember when writing such a wrapper, that it still needs to invoke the + previous version of the method, so that it plays nicely in combination + with others (see the `$orig->( @_ )' part). + +EXAMPLES + The following examples all demonstrate possible uses of a `Future' + object to provide a fictional asynchronous API. + + For more examples, comparing the use of `Future' with regular + call/return style Perl code, see also Future::Phrasebook. + + Providing Results + By returning a new `Future' object each time the asynchronous function + is called, it provides a placeholder for its eventual result, and a way + to indicate when it is complete. + + sub foperation + { + my %args = @_; + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => sub { $future->done( @_ ); }, + ); + + return $future; + } + + In most cases, the `done' method will simply be invoked with the entire + result list as its arguments. In that case, it is simpler to use the + `done_cb' wrapper method to create the `CODE' reference. + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => $future->done_cb, + ); + + The caller may then use this future to wait for a result using the + `on_ready' method, and obtain the result using `get'. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + say "The operation returned: ", $f->get; + } ); + + Indicating Success or Failure + Because the stored exception value of a failed future may not be false, + the `failure' method can be used in a conditional statement to detect + success or failure. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + if( not my $e = $f->failure ) { + say "The operation succeeded with: ", $f->get; + } + else { + say "The operation failed with: ", $e; + } + } ); + + By using `not' in the condition, the order of the `if' blocks can be + arranged to put the successful case first, similar to a `try'/`catch' + block. + + Because the `get' method re-raises the passed exception if the future + failed, it can be used to control a `try'/`catch' block directly. (This + is sometimes called *Exception Hoisting*). + + use Try::Tiny; + + $f->on_ready( sub { + my $f = shift; + try { + say "The operation succeeded with: ", $f->get; + } + catch { + say "The operation failed with: ", $_; + }; + } ); + + Even neater still may be the separate use of the `on_done' and `on_fail' + methods. + + $f->on_done( sub { + my @result = @_; + say "The operation succeeded with: ", @result; + } ); + $f->on_fail( sub { + my ( $failure ) = @_; + say "The operation failed with: $failure"; + } ); + + Immediate Futures + Because the `done' method returns the future object itself, it can be + used to generate a `Future' that is immediately ready with a result. + This can also be used as a class method. + + my $f = Future->done( $value ); + + Similarly, the `fail' and `die' methods can be used to generate a + `Future' that is immediately failed. + + my $f = Future->die( "This is never going to work" ); + + This could be considered similarly to a `die' call. + + An `eval{}' block can be used to turn a `Future'-returning function that + might throw an exception, into a `Future' that would indicate this + failure. + + my $f = eval { function() } || Future->fail( $@ ); + + This is neater handled by the `call' class method, which wraps the call + in an `eval{}' block and tests the result: + + my $f = Future->call( \&function ); + + Sequencing + The `then' method can be used to create simple chains of dependent + tasks, each one executing and returning a `Future' when the previous + operation succeeds. + + my $f = do_first() + ->then( sub { + return do_second(); + }) + ->then( sub { + return do_third(); + }); + + The result of the `$f' future itself will be the result of the future + returned by the final function, if none of them failed. If any of them + fails it will fail with the same failure. This can be considered similar + to normal exception handling in synchronous code; the first time a + function call throws an exception, the subsequent calls are not made. + + Merging Control Flow + A `wait_all' future may be used to resynchronise control flow, while + waiting for multiple concurrent operations to finish. + + my $f1 = foperation( foo => "something" ); + my $f2 = foperation( bar => "something else" ); + + my $f = Future->wait_all( $f1, $f2 ); + + $f->on_ready( sub { + say "Operations are ready:"; + say " foo: ", $f1->get; + say " bar: ", $f2->get; + } ); + + This provides an ability somewhat similar to `CPS::kpar()' or + Async::MergePoint. + +KNOWN ISSUES + Cancellation of Non-Final Sequence Futures + The behaviour of future cancellation still has some unanswered questions + regarding how to handle the situation where a future is cancelled that + has a sequence future constructed from it. + + In particular, it is unclear in each of the following examples what the + behaviour of `$f2' should be, were `$f1' to be cancelled: + + $f2 = $f1->then( sub { ... } ); # plus related ->then_with_f, ... + + $f2 = $f1->else( sub { ... } ); # plus related ->else_with_f, ... + + $f2 = $f1->followed_by( sub { ... } ); + + In the `then'-style case it is likely that this situation should be + treated as if `$f1' had failed, perhaps with some special message. The + `else'-style case is more complex, because it may be that the entire + operation should still fail, or it may be that the cancellation of `$f1' + should again be treated simply as a special kind of failure, and the + `else' logic run as normal. + + To be specific; in each case it is unclear what happens if the first + future is cancelled, while the second one is still waiting on it. The + semantics for "normal" top-down cancellation of `$f2' and how it affects + `$f1' are already clear and defined. + + Cancellation of Divergent Flow + A further complication of cancellation comes from the case where a given + future is reused multiple times for multiple sequences or convergent + trees. + + In particular, it is in clear in each of the following examples what the + behaviour of `$f2' should be, were `$f1' to be cancelled: + + my $f_initial = Future->new; ... + my $f1 = $f_initial->then( ... ); + my $f2 = $f_initial->then( ... ); + + my $f1 = Future->needs_all( $f_initial ); + my $f2 = Future->needs_all( $f_initial ); + + The point of cancellation propagation is to trace backwards through + stages of some larger sequence of operations that now no longer need to + happen, because the final result is no longer required. But in each of + these cases, just because `$f1' has been cancelled, the initial future + `$f_initial' is still required because there is another future (`$f2') + that will still require its result. + + Initially it would appear that some kind of reference-counting mechanism + could solve this question, though that itself is further complicated by + the `on_ready' handler and its variants. + + It may simply be that a comprehensive useful set of cancellation + semantics can't be universally provided to cover all cases; and that + some use-cases at least would require the application logic to give + extra information to its `Future' objects on how they should wire up the + cancel propagation logic. + + Both of these cancellation issues are still under active design + consideration; see the discussion on RT96685 for more information + (https://rt.cpan.org/Ticket/Display.html?id=96685). + +SEE ALSO + * curry - Create automatic curried method call closures for any class + or object + + * "The Past, The Present and The Future" - slides from a talk given at + the London Perl Workshop, 2012. + + https://docs.google.com/presentation/d/1UkV5oLcTOOXBXPh8foyxko4PR28_ + zU_aVx6gBms7uoo/edit + + * "Futures advent calendar 2013" + + http://leonerds-code.blogspot.co.uk/2013/12/futures-advent-day-1.htm + l + +TODO + * Consider the ability to pass the constructor an `await' CODEref, + instead of needing to use a subclass. This might simplify + async/etc.. implementations, and allows the reuse of the idea of + subclassing to extend the abilities of `Future' itself - for example + to allow a kind of Future that can report incremental progress. + +AUTHOR + Paul Evans + diff --git a/examples/io-async.pl b/examples/io-async.pl new file mode 100644 index 0000000..7763db1 --- /dev/null +++ b/examples/io-async.pl @@ -0,0 +1,9 @@ +use IO::Async::Loop 0.56; # Already has Future support built-in ;) + +my $loop = IO::Async::Loop->new; + +my $timer = $loop->delay_future( after => 3 ); +print "Awaiting 3 seconds...\n"; + +$timer->get; +print "Done\n"; diff --git a/lib/Future.pm b/lib/Future.pm new file mode 100644 index 0000000..07d7490 --- /dev/null +++ b/lib/Future.pm @@ -0,0 +1,2200 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2011-2015 -- leonerd@leonerd.org.uk + +package Future; + +use strict; +use warnings; +no warnings 'recursion'; # Disable the "deep recursion" warning + +our $VERSION = '0.32'; + +use Carp qw(); # don't import croak +use Scalar::Util qw( weaken blessed reftype ); +use B qw( svref_2object ); +use Time::HiRes qw( gettimeofday tv_interval ); + +# we are not overloaded, but we want to check if other objects are +require overload; + +our @CARP_NOT = qw( Future::Utils ); + +use constant DEBUG => $ENV{PERL_FUTURE_DEBUG}; + +our $TIMES = DEBUG || $ENV{PERL_FUTURE_TIMES}; + +=head1 NAME + +C - 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. + +=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 provides a method called C, this will be called by the +C and C methods if the instance is pending. + + $f->await + +In most cases this should allow future-returning modules to be used as if they +were blocking call/return-style modules, by simply appending a C call to +the function or method calls. + + my ( $results, $here ) = future_returning_function( @args )->get; + +The F directory in the distribution contains some examples of how +futures might be integrated with various event systems. + +=head2 MODULE DOCUMENTATION + +Modules that provide future-returning functions or methods may wish to adopt +the following styles in some way, to document the eventual return values from +these futures. + + func( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + + OBJ->method( ARGS, HERE... ) ==> ( RETURN, VALUES... ) + +Code returning a future that yields no values on success can use empty +parentheses. + + func( ... ) ==> () + +=head2 DEBUGGING + +By the time a C 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). + +=cut + +=head1 CONSTRUCTORS + +=cut + +=head2 $future = Future->new + +=head2 $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 +}; + +use constant CB_ALWAYS => CB_DONE|CB_FAIL|CB_CANCEL; + +# Useful for identifying CODE references +sub CvNAME_FILE_LINE +{ + my ( $code ) = @_; + my $cv = svref_2object( $code ); + + my $name = join "::", $cv->STASH->NAME, $cv->GV->NAME; + return $name unless $cv->GV->NAME eq "__ANON__"; + + # $cv->GV->LINE isn't reliable, as outside of perl -d mode all anon CODE + # in the same file actually shares the same GV. :( + # Walk the optree looking for the first COP + my $cop = $cv->START; + $cop = $cop->next while $cop and ref $cop ne "B::COP"; + + sprintf "%s(%s line %d)", $cv->GV->NAME, $cop->file, $cop->line; +} + +sub _callable +{ + my ( $cb ) = @_; + defined $cb and ( reftype($cb) eq 'CODE' || overload::Method($cb, '&{}') ); +} + +sub new +{ + my $proto = shift; + return bless { + ready => 0, + callbacks => [], # [] = [$type, ...] + ( DEBUG ? + ( do { my $at = Carp::shortmess( "constructed" ); + chomp $at; $at =~ s/\.$//; + constructed_at => $at } ) + : () ), + ( $TIMES ? + ( btime => [ gettimeofday ] ) + : () ), + }, ( ref $proto || $proto ); +} + +my $GLOBAL_END; +END { $GLOBAL_END = 1; } + +sub DESTROY_debug { + my $self = shift; + return if $GLOBAL_END; + return if $self->{ready} and ( $self->{reported} or !$self->{failure} ); + + my $lost_at = join " line ", (caller)[1,2]; + # We can't actually know the real line where the last reference was lost; + # a variable set to 'undef' or close of scope, because caller can't see it; + # the current op has already been updated. The best we can do is indicate + # 'near'. + + if( $self->{ready} and $self->{failure} ) { + warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at with an unreported failure of: " . + $self->{failure}[0] . "\n"; + } + elsif( !$self->{ready} ) { + warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at before it was ready.\n"; + } +} +*DESTROY = \&DESTROY_debug if DEBUG; + +=head2 $future = Future->done( @values ) + +=head2 $future = Future->fail( $exception, @details ) + +Shortcut wrappers around creating a new C then immediately marking it +as done or failed. + +=head2 $future = Future->wrap( @values ) + +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 $future = Future->call( \&code, @args ) + +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}; + my $callbacks = delete $self->{callbacks} or return; + + my $cancelled = $self->{cancelled}; + my $fail = defined $self->{failure}; + my $done = !$fail && !$cancelled; + + my @result = $done ? $self->get : + $fail ? $self->failure : + (); + + foreach my $cb ( @$callbacks ) { + my ( $flags, $code ) = @$cb; + my $is_future = blessed( $code ) && $code->isa( "Future" ); + + next if $done and not( $flags & CB_DONE ); + next if $fail and not( $flags & CB_FAIL ); + next if $cancelled and not( $flags & CB_CANCEL ); + + $self->{reported} = 1 if $fail; + + if( $is_future ) { + $done ? $code->done( @result ) : + $fail ? $code->fail( @result ) : + $code->cancel; + } + elsif( $flags & (CB_SEQ_ONDONE|CB_SEQ_ONFAIL) ) { + my ( undef, undef, $fseq ) = @$cb; + if( !$fseq ) { # weaken()ed; it might be gone now + # This warning should always be printed, even not in DEBUG mode. + # It's always an indication of a bug + Carp::carp +(DEBUG ? "${\$self->__selfstr} ($self->{constructed_at})" + : "${\$self->__selfstr} $self" ) . + " lost a sequence Future"; + next; + } + + my $f2; + if( $done and $flags & CB_SEQ_ONDONE or + $fail and $flags & CB_SEQ_ONFAIL ) { + + if( $flags & CB_SEQ_IMDONE ) { + $fseq->done( @$code ); + next; + } + elsif( $flags & CB_SEQ_IMFAIL ) { + $fseq->fail( @$code ); + next; + } + + my @args = ( + ( $flags & CB_SELF ? $self : () ), + ( $flags & CB_RESULT ? @result : () ), + ); + + unless( eval { $f2 = $code->( @args ); 1 } ) { + $fseq->fail( $@ ); + next; + } + + unless( blessed $f2 and $f2->isa( "Future" ) ) { + $fseq->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); + next; + } + + $fseq->on_cancel( $f2 ); + } + else { + $f2 = $self; + } + + if( $f2->is_ready ) { + $f2->on_ready( $fseq ) if !$f2->{cancelled}; + } + else { + push @{ $f2->{callbacks} }, [ CB_DONE|CB_FAIL, $fseq ]; + weaken( $f2->{callbacks}[-1][1] ); + } + } + else { + $code->( + ( $flags & CB_SELF ? $self : () ), + ( $flags & CB_RESULT ? @result : () ), + ); + } + } +} + +sub _state +{ + my $self = shift; + return !$self->{ready} ? "pending" : + DEBUG ? $self->{ready_at} : + $self->{failure} ? "failed" : + $self->{cancelled} ? "cancelled" : + "done"; +} + +=head1 IMPLEMENTATION METHODS + +These methods would primarily be used by implementations of asynchronous +interfaces. + +=cut + +=head2 $future->done( @result ) + +Marks that the leaf future is now ready, and provides a list of values as a +result. (The empty list is allowed, and still indicates the future as ready). +Cannot be called on a convergent future. + +If the future is already cancelled, this request is ignored. If the future is +already complete with a result or a failure, an exception is thrown. + +=head2 Future->done( @result ) + +May also be called as a class method, where it will construct a new Future and +immediately mark it as done. + +Returns the C<$future> to allow easy chaining to create an immediate future by + + return Future->done( ... ) + +=cut + +sub done +{ + my $self = shift; + + if( ref $self ) { + $self->{cancelled} and return $self; + $self->{ready} and Carp::croak "${\$self->__selfstr} is already ".$self->_state." and cannot be ->done"; + $self->{subs} and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->done"; + $self->{result} = [ @_ ]; + $self->_mark_ready( "done" ); + } + else { + $self = $self->new; + $self->{ready} = 1; + $self->{ready_at} = _shortmess "done" if DEBUG; + $self->{result} = [ @_ ]; + } + + return $self; +} + +=head2 $code = $future->done_cb + +Returns a C reference that, when invoked, calls the C method. This +makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::done; + +=cut + +sub done_cb +{ + my $self = shift; + return sub { $self->done( @_ ) }; +} + +=head2 $future->fail( $exception, @details ) + +Marks that the leaf future has failed, and provides an exception value. This +exception will be thrown by the C method if called. + +The exception must evaluate as a true value; false exceptions are not allowed. +Further details may be provided that will be returned by the C method +in list context. These details will not be part of the exception string raised +by C. + +If the future is already cancelled, this request is ignored. If the future is +already complete with a result or a failure, an exception is thrown. + +=head2 Future->fail( $exception, @details ) + +May also be called as a class method, where it will construct a new Future and +immediately mark it as failed. + +Returns the C<$future> to allow easy chaining to create an immediate failed +future by + + return Future->fail( ... ) + +=cut + +sub fail +{ + my $self = shift; + my ( $exception, @details ) = @_; + + $_[0] or Carp::croak "$self ->fail requires an exception that is true"; + + if( ref $self ) { + $self->{cancelled} and return $self; + $self->{ready} and Carp::croak "${\$self->__selfstr} is already ".$self->_state." and cannot be ->fail'ed"; + $self->{subs} and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->fail'ed"; + $self->{failure} = [ $exception, @details ]; + $self->_mark_ready( "fail" ); + } + else { + $self = $self->new; + $self->{ready} = 1; + $self->{ready_at} = _shortmess "fail" if DEBUG; + $self->{failure} = [ $exception, @details ]; + } + + if( DEBUG ) { + my $at = Carp::shortmess( "failed" ); + chomp $at; $at =~ s/\.$//; + $self->{ready_at} = $at; + } + + return $self; +} + +=head2 $code = $future->fail_cb + +Returns a C reference that, when invoked, calls the C method. This +makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::fail; + +=cut + +sub fail_cb +{ + my $self = shift; + return sub { $self->fail( @_ ) }; +} + +=head2 $future->die( $message, @details ) + +A convenient wrapper around C. 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, @details ) = @_; + + if( !ref $exception and $exception !~ m/\n$/ ) { + $exception .= sprintf " at %s line %d\n", (caller)[1,2]; + } + + $self->fail( $exception, @details ); +} + +=head2 $future->on_cancel( $code ) + +If the future is not yet ready, adds a callback to be invoked if the future is +cancelled by the C method. If the future is already ready, throws an +exception. + +If the future is cancelled, the callbacks will be invoked in the reverse order +to that in which they were registered. + + $on_cancel->( $future ) + +=head2 $future->on_cancel( $f ) + +If passed another C instance, the passed instance will be cancelled +when the original future is cancelled. This method does nothing if the future +is already complete. + +=cut + +sub on_cancel +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_cancel"; + + $self->{ready} and return $self; + + push @{ $self->{on_cancel} }, $code; + + return $self; +} + +=head2 $cancelled = $future->is_cancelled + +Returns true if the future has been cancelled by C. + +=cut + +sub is_cancelled +{ + my $self = shift; + return $self->{cancelled}; +} + +=head1 USER METHODS + +These methods would primarily be used by users of asynchronous interfaces, on +objects returned by such an interface. + +=cut + +=head2 $ready = $future->is_ready + +Returns true on a leaf future if a result has been provided to the C +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}; +} + +=head2 $future->on_ready( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +is ready. If the future is already ready, invokes it immediately. + +In either case, the callback will be passed the future object itself. The +invoked code can then obtain the list of results by calling the C method. + + $on_ready->( $future ) + +Returns the C<$future>. + +=head2 $future->on_ready( $f ) + +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. + +=cut + +sub on_ready +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_ready"; + + if( $self->{ready} ) { + my $fail = defined $self->{failure}; + my $done = !$fail && !$self->{cancelled}; + + $self->{reported} = 1 if $fail; + + $is_future ? ( $done ? $code->done( $self->get ) : + $fail ? $code->fail( $self->failure ) : + $code->cancel ) + : $code->( $self ); + } + else { + push @{ $self->{callbacks} }, [ CB_ALWAYS|CB_SELF, $self->wrap_cb( on_ready => $code ) ]; + } + + return $self; +} + +=head2 $done = $future->is_done + +Returns true on a future if it is ready and completed successfully. Returns +false if it is still pending, failed, or was cancelled. + +=cut + +sub is_done +{ + my $self = shift; + return $self->{ready} && !$self->{failure} && !$self->{cancelled}; +} + +=head2 @result = $future->get + +=head2 $result = $future->get + +If the future is ready and completed successfully, returns the list of +results that had earlier been given to the C method on a leaf future, +or the list of component futures it was waiting for on a convergent future. In +scalar context it returns just the first result value. + +If the future is ready but failed, this method raises as an exception the +failure string or object that was given to the C method. + +If the future was cancelled an exception is thrown. + +If it is not yet ready and is not of a subclass that provides an C +method an exception is thrown. If it is subclassed to provide an C +method then this is used to wait for the future to be ready, before returning +the result or propagating its failure exception. + +=cut + +sub await +{ + my $self = shift; + Carp::croak "$self is not yet complete and does not provide ->await"; +} + +sub get +{ + my $self = shift; + $self->await until $self->{ready}; + if( $self->{failure} ) { + $self->{reported} = 1; + my $exception = $self->{failure}->[0]; + !ref $exception && $exception =~ m/\n$/ ? CORE::die $exception : Carp::croak $exception; + } + $self->{cancelled} and Carp::croak "${\$self->__selfstr} was cancelled"; + return $self->{result}->[0] unless wantarray; + return @{ $self->{result} }; +} + +=head2 @values = Future->unwrap( @values ) + +If given a single argument which is a C 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 C, this method can only be used on immediate +futures or subclasses that implement C. + +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 $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 ) + +Returns the C<$future>. + +=head2 $future->on_done( $f ) + +If passed another C instance, the passed instance will have its +C method invoked when the original future completes successfully. + +=cut + +sub on_done +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_done"; + + if( $self->{ready} ) { + return $self if $self->{failure} or $self->{cancelled}; + + $is_future ? $code->done( $self->get ) + : $code->( $self->get ); + } + else { + push @{ $self->{callbacks} }, [ CB_DONE|CB_RESULT, $self->wrap_cb( on_done => $code ) ]; + } + + return $self; +} + +=head2 $failed = $future->is_failed + +Returns true on a future if it is ready and it failed. Returns false if it is +still pending, completed successfully, or was cancelled. + +=cut + +sub is_failed +{ + my $self = shift; + return $self->{ready} && !!$self->{failure}; # boolify +} + +=head2 $exception = $future->failure + +=head2 $exception, @details = $future->failure + +Returns the exception passed to the C method, C if the future +completed successfully via the C method, or raises an exception if +called on a future that is not yet ready. + +If called in list context, will additionally yield a list of the details +provided to the C 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->get; + ... + } + +=cut + +sub failure +{ + my $self = shift; + $self->await until $self->{ready}; + return unless $self->{failure}; + $self->{reported} = 1; + return $self->{failure}->[0] if !wantarray; + return @{ $self->{failure} }; +} + +=head2 $future->on_fail( $code ) + +If the future is not yet ready, adds a callback to be invoked when the future +is ready, if it fails. If the future has already failed, invokes it +immediately. If it completed successfully or was cancelled, it is not invoked +at all. + +The callback will be passed the exception and details passed to the C +method. + + $on_fail->( $exception, @details ) + +Returns the C<$future>. + +=head2 $future->on_fail( $f ) + +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( @_ ) } ); + +=cut + +sub on_fail +{ + my $self = shift; + my ( $code ) = @_; + + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future or _callable( $code ) or + Carp::croak "Expected \$code to be callable or a Future in ->on_fail"; + + if( $self->{ready} ) { + return $self if not $self->{failure}; + $self->{reported} = 1; + + $is_future ? $code->fail( $self->failure ) + : $code->( $self->failure ); + } + else { + push @{ $self->{callbacks} }, [ CB_FAIL|CB_RESULT, $self->wrap_cb( on_fail => $code ) ]; + } + + return $self; +} + +=head2 $future->cancel + +Requests that the future be cancelled, immediately marking it as ready. This +will invoke all of the code blocks registered by C, in the reverse +order. When called on a convergent future, all its component futures are also +cancelled. It is not an error to attempt to cancel a future that is already +complete or cancelled; it simply has no effect. + +Returns the C<$future>. + +=cut + +sub cancel +{ + my $self = shift; + + return $self if $self->{ready}; + + $self->{cancelled}++; + foreach my $code ( reverse @{ $self->{on_cancel} || [] } ) { + my $is_future = blessed( $code ) && $code->isa( "Future" ); + $is_future ? $code->cancel + : $code->( $self ); + } + $self->_mark_ready( "cancel" ); + + return $self; +} + +=head2 $code = $future->cancel_cb + +Returns a C reference that, when invoked, calls the C method. +This makes it simple to pass as a callback function to other code. + +As the same effect can be achieved using L, this method is deprecated +now and may be removed in a later version. + + $code = $future->curry::cancel; + +=cut + +sub cancel_cb +{ + my $self = shift; + return sub { $self->cancel }; +} + +=head1 SEQUENCING METHODS + +The following methods all return a new future to represent the combination of +its invocant followed by another action given by a code reference. The +combined activity waits for the first future to be ready, then may invoke the +code depending on the success or failure of the first, or may run it +regardless. The returned sequence future represents the entire combination of +activity. + +In some cases the code should return a future; in some it should return an +immediate result. If a future is returned, the combined future will then wait +for the result of this second one. If the combinined future is cancelled, it +will cancel either the first future or the second, depending whether the first +had completed. If the code block throws an exception instead of returning a +value, the sequence future will fail with that exception as its message and no +further values. + +As it is always a mistake to call these sequencing methods in void context and lose the +reference to the returned future (because exception/error handling would be +silently dropped), this method warns in void context. + +=cut + +sub _sequence +{ + my $f1 = shift; + my ( $code, $flags ) = @_; + + # For later, we might want to know where we were called from + my $func = (caller 1)[3]; + $func =~ s/^.*:://; + + $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL) or _callable( $code ) or + Carp::croak "Expected \$code to be callable in ->$func"; + + if( !defined wantarray ) { + Carp::carp "Calling ->$func in void context"; + } + + if( $f1->is_ready ) { + # Take a shortcut + return $f1 if $f1->is_done and not( $flags & CB_SEQ_ONDONE ) or + $f1->failure and not( $flags & CB_SEQ_ONFAIL ); + + if( $flags & CB_SEQ_IMDONE ) { + return Future->done( @$code ); + } + elsif( $flags & CB_SEQ_IMFAIL ) { + return Future->fail( @$code ); + } + + my @args = ( + ( $flags & CB_SELF ? $f1 : () ), + ( $flags & CB_RESULT ? $f1->is_done ? $f1->get : + $f1->failure ? $f1->failure : + () : () ), + ); + + my $fseq; + unless( eval { $fseq = $code->( @args ); 1 } ) { + return Future->fail( $@ ); + } + + unless( blessed $fseq and $fseq->isa( "Future" ) ) { + return Future->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" ); + } + + return $fseq; + } + + my $fseq = $f1->new; + $fseq->on_cancel( $f1 ); + + # TODO: if anyone cares about the op name, we might have to synthesize it + # from $flags + $code = $f1->wrap_cb( sequence => $code ) unless $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL); + + push @{ $f1->{callbacks} }, [ CB_DONE|CB_FAIL|$flags, $code, $fseq ]; + weaken( $f1->{callbacks}[-1][2] ); + + return $fseq; +} + +=head2 $future = $f1->then( \&done_code ) + +Returns a new sequencing C that runs the code if the first succeeds. +Once C<$f1> succeeds the code reference will be invoked and is passed the list +of results. It should return a future, C<$f2>. Once C<$f2> completes the +sequence future will then be marked as complete with whatever result C<$f2> +gave. If C<$f1> fails then the sequence future will immediately fail with the +same failure and the code will not be invoked. + + $f2 = $done_code->( @result ) + +=head2 $future = $f1->else( \&fail_code ) + +Returns a new sequencing C that runs the code if the first fails. Once +C<$f1> fails the code reference will be invoked and is passed the failure and +details. It should return a future, C<$f2>. Once C<$f2> completes the sequence +future will then be marked as complete with whatever result C<$f2> gave. If +C<$f1> succeeds then the sequence future will immediately succeed with the +same result and the code will not be invoked. + + $f2 = $fail_code->( $exception, @details ) + +=head2 $future = $f1->then( \&done_code, \&fail_code ) + +The C method can also be passed the C<$fail_code> block as well, giving +a combination of C and C behaviour. + +This operation is designed to be compatible with the semantics of other future +systems, such as Javascript's Q or Promises/A libraries. + +=cut + +sub then +{ + my $self = shift; + my ( $done_code, $fail_code ) = @_; + + if( $done_code and !$fail_code ) { + return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_RESULT ); + } + + !$done_code or _callable( $done_code ) or + Carp::croak "Expected \$done_code to be callable in ->then"; + !$fail_code or _callable( $fail_code ) or + Carp::croak "Expected \$fail_code to be callable in ->then"; + + # Complex + return $self->_sequence( sub { + my $self = shift; + if( !$self->{failure} ) { + return $self unless $done_code; + return $done_code->( $self->get ); + } + else { + return $self unless $fail_code; + return $fail_code->( $self->failure ); + } + }, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); +} + +sub else +{ + my $self = shift; + my ( $fail_code ) = @_; + + return $self->_sequence( $fail_code, CB_SEQ_ONFAIL|CB_RESULT ); +} + +=head2 $future = $f1->transform( %args ) + +Returns a new sequencing C 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->get ); + return $self->new->done( @result ); + } + else { + return $self unless $xfrm_fail; + my @failure = $xfrm_fail->( $self->failure ); + return $self->new->fail( @failure ); + } + }, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); +} + +=head2 $future = $f1->then_with_f( \&code ) + +Returns a new sequencing C that runs the code if the first succeeds. +Identical to C, except that the code reference will be passed both the +original future, C<$f1>, and its result. + + $f2 = $code->( $f1, @result ) + +This is useful for conditional execution cases where the code block may just +return the same result of the original future. In this case it is more +efficient to return the original future itself. + +=cut + +sub then_with_f +{ + my $self = shift; + my ( $done_code ) = @_; + + return $self->_sequence( $done_code, CB_SEQ_ONDONE|CB_SELF|CB_RESULT ); +} + +=head2 $future = $f->then_done( @result ) + +=head2 $future = $f->then_fail( $exception, @details ) + +Convenient shortcuts to returning an immediate future from a C block, +when the result is already known. + +=cut + +sub then_done +{ + my $self = shift; + my ( @result ) = @_; + return $self->_sequence( \@result, CB_SEQ_ONDONE|CB_SEQ_IMDONE ); +} + +sub then_fail +{ + my $self = shift; + my ( @failure ) = @_; + return $self->_sequence( \@failure, CB_SEQ_ONDONE|CB_SEQ_IMFAIL ); +} + +=head2 $future = $f1->else_with_f( \&code ) + +Returns a new sequencing C 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 details. + + $f2 = $code->( $f1, $exception, @details ) + +This is useful for conditional execution cases where the code block may just +return the same result of the original future. In this case it is more +efficient to return the original future itself. + +=cut + +sub else_with_f +{ + my $self = shift; + my ( $fail_code ) = @_; + + return $self->_sequence( $fail_code, CB_SEQ_ONFAIL|CB_SELF|CB_RESULT ); +} + +=head2 $future = $f->else_done( @result ) + +=head2 $future = $f->else_fail( $exception, @details ) + +Convenient shortcuts to returning an immediate future from a C block, +when the result is already known. + +=cut + +sub else_done +{ + my $self = shift; + my ( @result ) = @_; + return $self->_sequence( \@result, CB_SEQ_ONFAIL|CB_SEQ_IMDONE ); +} + +sub else_fail +{ + my $self = shift; + my ( @failure ) = @_; + return $self->_sequence( \@failure, CB_SEQ_ONFAIL|CB_SEQ_IMFAIL ); +} + +=head2 $future = $f1->followed_by( \&code ) + +Returns a new sequencing C that runs the code regardless of success or +failure. Once C<$f1> is ready the code reference will be invoked and is passed +one argument, C<$f1>. It should return a future, C<$f2>. Once C<$f2> completes +the sequence future will then be marked as complete with whatever result +C<$f2> gave. + + $f2 = $code->( $f1 ) + +=cut + +sub followed_by +{ + my $self = shift; + my ( $code ) = @_; + + return $self->_sequence( $code, CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF ); +} + +sub and_then +{ + Carp::croak "Future->and_then is now removed; use ->then_with_f instead"; +} + +sub or_else +{ + Carp::croak "Future->or_else is now removed; use ->else_with_f instead"; +} + +=head2 $future = $f1->without_cancel + +Returns a new sequencing C that will complete with the success or +failure of the original future, but if cancelled, will not cancel the +original. This may be useful if the original future represents an operation +that is being shared among multiple sequences; cancelling one should not +prevent the others from running too. + +=cut + +sub without_cancel +{ + my $self = shift; + my $new = $self->new; + + $self->on_ready( sub { + my $self = shift; + if( $self->failure ) { + $new->fail( $self->failure ); + } + else { + $new->done( $self->get ); + } + }); + + return $new; +} + +=head1 CONVERGENT FUTURES + +The following constructors all take a list of component futures, and return a +new future whose readiness somehow depends on the readiness of those +components. The first derived class component future will be used as the +prototype for constructing the return value, so it respects subclassing +correctly, or failing that a plain C. + +=cut + +sub _new_convergent +{ + shift; # ignore this class + my ( $subs ) = @_; + + foreach my $sub ( @$subs ) { + blessed $sub and $sub->isa( "Future" ) or Carp::croak "Expected a Future, got $_"; + } + + # Find the best prototype. Ideally anything derived if we can find one. + my $self; + ref($_) eq "Future" or $self = $_->new, last for @$subs; + + # No derived ones; just have to be a basic class then + $self ||= Future->new; + + $self->{subs} = $subs; + + # This might be called by a DESTROY during global destruction so it should + # be as defensive as possible (see RT88967) + $self->on_cancel( sub { + foreach my $sub ( @$subs ) { + $sub->cancel if $sub and !$sub->{ready}; + } + } ); + + return $self; +} + +=head2 $future = Future->wait_all( @subfutures ) + +Returns a new C instance that will indicate it is ready once all of +the sub future objects given to it indicate that they are ready, either by +success, failure or cancellation. Its result will a list of its component +futures. + +When given an empty list this constructor returns a new immediately-done +future. + +This constructor would primarily be used by users of asynchronous interfaces. + +=cut + +sub wait_all +{ + my $class = shift; + my @subs = @_; + + unless( @subs ) { + my $self = $class->done; + $self->{subs} = []; + return $self; + } + + my $self = Future->_new_convergent( \@subs ); + + my $pending = 0; + $_->{ready} or $pending++ for @subs; + + # Look for immediate ready + if( !$pending ) { + $self->{result} = [ @subs ]; + $self->_mark_ready( "wait_all" ); + return $self; + } + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + + $pending--; + $pending and return; + + $weakself->{result} = [ @subs ]; + $weakself->_mark_ready( "wait_all" ); + }; + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->on_ready( $sub_on_ready ); + } + + return $self; +} + +=head2 $future = Future->wait_any( @subfutures ) + +Returns a new C instance that will indicate it is ready once any of +the sub future objects given to it indicate that they are ready, either by +success or failure. Any remaining component futures that are not yet ready +will be cancelled. Its result will be the result of the first component future +that was ready; either success or failure. Any component futures that are +cancelled are ignored, apart from the final component left; at which point the +result will be a failure. + +When given an empty list this constructor returns an immediately-failed +future. + +This constructor would primarily be used by users of asynchronous interfaces. + +=cut + +sub wait_any +{ + my $class = shift; + my @subs = @_; + + unless( @subs ) { + my $self = $class->fail( "Cannot ->wait_any with no subfutures" ); + $self->{subs} = []; + return $self; + } + + my $self = Future->_new_convergent( \@subs ); + + # Look for immediate ready + my $immediate_ready; + foreach my $sub ( @subs ) { + $sub->{ready} and $immediate_ready = $sub, last; + } + + if( $immediate_ready ) { + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->cancel; + } + + if( $immediate_ready->{failure} ) { + $self->{failure} = [ $immediate_ready->failure ]; + } + else { + $self->{result} = [ $immediate_ready->get ]; + } + $self->_mark_ready( "wait_any" ); + return $self; + } + + my $pending = 0; + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel + + return if --$pending and $_[0]->{cancelled}; + + if( $_[0]->{cancelled} ) { + $weakself->{failure} = [ "All component futures were cancelled" ]; + } + elsif( $_[0]->{failure} ) { + $weakself->{failure} = [ $_[0]->failure ]; + } + else { + $weakself->{result} = [ $_[0]->get ]; + } + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->cancel; + } + + $weakself->_mark_ready( "wait_any" ); + }; + + foreach my $sub ( @subs ) { + # No need to test $sub->{ready} since we know none of them are + $sub->on_ready( $sub_on_ready ); + $pending++; + } + + return $self; +} + +=head2 $future = Future->needs_all( @subfutures ) + +Returns a new C 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 { $_->get } @subs ]; + $self->_mark_ready( "needs_all" ); + return $self; + } + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel + + if( $_[0]->{cancelled} ) { + $weakself->{failure} = [ "A component future was cancelled" ]; + foreach my $sub ( @subs ) { + $sub->cancel if !$sub->{ready}; + } + $weakself->_mark_ready( "needs_all" ); + } + elsif( my @failure = $_[0]->failure ) { + $weakself->{failure} = \@failure; + foreach my $sub ( @subs ) { + $sub->cancel if !$sub->{ready}; + } + $weakself->_mark_ready( "needs_all" ); + } + else { + $pending--; + $pending and return; + + $weakself->{result} = [ map { $_->get } @subs ]; + $weakself->_mark_ready( "needs_all" ); + } + }; + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->on_ready( $sub_on_ready ); + } + + return $self; +} + +=head2 $future = Future->needs_any( @subfutures ) + +Returns a new C 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->get ]; + $self->_mark_ready( "needs_any" ); + return $self; + } + + # Look for immediate fail + my $immediate_fail = 1; + foreach my $sub ( @subs ) { + $sub->{ready} or $immediate_fail = 0, last; + } + + if( $immediate_fail ) { + $_->{reported} = 1 for @subs; + # For consistency we'll pick the last one for the failure + $self->{failure} = [ $subs[-1]->{failure} ]; + $self->_mark_ready( "needs_any" ); + return $self; + } + + weaken( my $weakself = $self ); + my $sub_on_ready = sub { + return unless $weakself; + return if $weakself->{result} or $weakself->{failure}; # don't recurse on child ->cancel + + return if --$pending and $_[0]->{cancelled}; + + if( $_[0]->{cancelled} ) { + $weakself->{failure} = [ "All component futures were cancelled" ]; + $weakself->_mark_ready( "needs_any" ); + } + elsif( my @failure = $_[0]->failure ) { + $pending and return; + + $weakself->{failure} = \@failure; + $weakself->_mark_ready( "needs_any" ); + } + else { + $weakself->{result} = [ $_[0]->get ]; + foreach my $sub ( @subs ) { + $sub->cancel if !$sub->{ready}; + } + $weakself->_mark_ready( "needs_any" ); + } + }; + + foreach my $sub ( @subs ) { + $sub->{ready} or $sub->on_ready( $sub_on_ready ); + } + + return $self; +} + +=head1 METHODS ON CONVERGENT FUTURES + +The following methods apply to convergent (i.e. non-leaf) futures, to access +the component futures stored by it. + +=cut + +=head2 @f = $future->pending_futures + +=head2 @f = $future->ready_futures + +=head2 @f = $future->done_futures + +=head2 @f = $future->failed_futures + +=head2 @f = $future->cancelled_futures + +Return a list of all the pending, ready, done, failed, or cancelled +component futures. In scalar context, each will yield the number of such +component futures. + +=cut + +sub pending_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->pending_futures on a non-convergent Future"; + return grep { not $_->{ready} } @{ $self->{subs} }; +} + +sub ready_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->ready_futures on a non-convergent Future"; + return grep { $_->{ready} } @{ $self->{subs} }; +} + +sub done_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->done_futures on a non-convergent Future"; + return grep { $_->{ready} and not $_->{failure} and not $_->{cancelled} } @{ $self->{subs} }; +} + +sub failed_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->failed_futures on a non-convergent Future"; + return grep { $_->{ready} and $_->{failure} } @{ $self->{subs} }; +} + +sub cancelled_futures +{ + my $self = shift; + $self->{subs} or Carp::croak "Cannot call ->cancelled_futures on a non-convergent Future"; + return grep { $_->{ready} and $_->{cancelled} } @{ $self->{subs} }; +} + +=head1 TRACING METHODS + +=head2 $future = $future->set_label( $label ) + +=head2 $label = $future->label + +Chaining mutator and accessor for the label of the C. This should be a +plain string value, whose value will be stored by the future instance for use +in debugging messages or other tooling, or similar purposes. + +=cut + +sub set_label +{ + my $self = shift; + ( $self->{label} ) = @_; + return $self; +} + +sub label +{ + my $self = shift; + return $self->{label}; +} + +sub __selfstr +{ + my $self = shift; + return "$self" unless defined $self->{label}; + return "$self (\"$self->{label}\")"; +} + +=head2 [ $sec, $usec ] = $future->btime + +=head2 [ $sec, $usec ] = $future->rtime + +Accessors that return the tracing timestamps from the instance. These give the +time the instance was contructed ("birth" time, C) 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 $sec = $future->elapsed + +If both tracing timestamps are defined, returns the number of seconds of +elapsed time between them as a floating-point number. If not, returns +C. + +=cut + +sub elapsed +{ + my $self = shift; + return undef unless defined $self->{btime} and defined $self->{rtime}; + return $self->{elapsed} ||= tv_interval( $self->{btime}, $self->{rtime} ); +} + +=head2 $cb = $future->wrap_cb( $operation_name, $cb ) + +I + +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 agument as-is; the method is +provided to allow users to provide extra behaviour. This can be done by +applying a method modifier of the C 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 simpler to use the +C wrapper method to create the C reference. + + my $future = Future->new; + + do_something_async( + foo => $args{foo}, + on_done => $future->done_cb, + ); + +The caller may then use this future to wait for a result using the C +method, and obtain the result using C. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + say "The operation returned: ", $f->get; + } ); + +=head2 Indicating Success or Failure + +Because the stored exception value of a failed future may not be false, the +C method can be used in a conditional statement to detect success or +failure. + + my $f = foperation( foo => "something" ); + + $f->on_ready( sub { + my $f = shift; + if( not my $e = $f->failure ) { + say "The operation succeeded with: ", $f->get; + } + else { + say "The operation failed with: ", $e; + } + } ); + +By using C 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 Try::Tiny; + + $f->on_ready( sub { + my $f = shift; + try { + say "The operation succeeded with: ", $f->get; + } + catch { + say "The operation failed with: ", $_; + }; + } ); + +Even neater still may be the separate use of the C 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->get; + say " bar: ", $f2->get; + } ); + +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 - 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 + +=back + +=cut + +=head1 TODO + +=over 4 + +=item * + +Consider the ability to pass the constructor an 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; diff --git a/lib/Future/Phrasebook.pod b/lib/Future/Phrasebook.pod new file mode 100644 index 0000000..2798536 --- /dev/null +++ b/lib/Future/Phrasebook.pod @@ -0,0 +1,500 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk + +=head1 NAME + +C - 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->get }; + +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->get, $f_b->get ); + } ); + +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 diff --git a/lib/Future/Utils.pm b/lib/Future/Utils.pm new file mode 100644 index 0000000..563f327 --- /dev/null +++ b/lib/Future/Utils.pm @@ -0,0 +1,687 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2013-2015 -- leonerd@leonerd.org.uk + +package Future::Utils; + +use strict; +use warnings; + +our $VERSION = '0.32'; + +use Exporter 'import'; +# Can't import the one from Exporter as it relies on package inheritance +sub export_to_level +{ + my $pkg = shift; local $Exporter::ExportLevel = 1 + shift; $pkg->import(@_); +} + +our @EXPORT_OK = qw( + call + call_with_escape + + repeat + try_repeat try_repeat_until_success + repeat_until_success + + fmap fmap_concat + fmap1 fmap_scalar + fmap0 fmap_void +); + +use Carp; +our @CARP_NOT = qw( Future ); + +use Future; + +=head1 NAME + +C - 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 $trail_f; + } until => sub { my $f = shift; return acceptable($f) }; + + my $eventual_f = repeat { + my $item = shift; + ... + return $trial_f; + } foreach => \@items; + + my $eventual_f = try_repeat { + my $trial_f = ... + return $trial_f; + } while => sub { ... }; + + my $eventual_f = try_repeat_until_success { + ... + return $trial_f; + }; + + my $eventual_f = try_repeat_until_success { + my $item = shift; + ... + return $trial_f; + } foreach => \@items; + +Z<> + + use Future::Utils qw( fmap_concat fmap_scalar fmap_void ); + + my $result_f = fmap_concat { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 4; + + my $result_f = fmap_scalar { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 8; + + my $done_f = fmap_void { + my $item = shift; + ... + return $item_f; + } foreach => \@items, concurrent => 10; + +=cut + +=head1 INVOKING A BLOCK OF CODE + +=head2 $f = call { CODE } + +The C 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 $f = call_with_escape { CODE } + +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 $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 $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 $future = repeat { CODE } foreach => ARRAY, otherwise => CODE + +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 $future = repeat { CODE } foreach => ARRAY, while => CODE, ... + +=head2 $future = repeat { CODE } foreach => ARRAY, until => CODE, ... + +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 $future = repeat { CODE } generate => CODE, otherwise => CODE + +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 $future = try_repeat { CODE } ... + +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 $future = try_repeat_until_success { CODE } ... + +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. + +=cut + +# This function is invoked in two circumstances: +# a) to create an item Future in a slot, +# b) once a non-immediate item Future is complete, to check its results +# It can tell which circumstance by whether the slot itself is defined or not +sub _fmap_slot +{ + my ( $slots, undef, $code, $generator, $collect, $results, $return ) = @_; + + SLOT: while(1) { + # Capture args each call because we mutate them + my ( undef, $idx ) = my @args = @_; + + unless( $slots->[$idx] ) { + # No item Future yet (case a), so create one + my $item; + unless( ( $item ) = $generator->() ) { + # All out of items, so now just wait for the slots to be finished + undef $slots->[$idx]; + defined and return $return for @$slots; + + # All the slots are done + $return ||= Future->new; + + $return->done( @$results ); + return $return; + } + + my $f = $slots->[$idx] = Future->call( $code, $item ); + + if( $collect eq "array" ) { + push @$results, my $r = []; + $f->on_done( sub { @$r = @_ }); + } + elsif( $collect eq "scalar" ) { + push @$results, undef; + my $r = \$results->[-1]; + $f->on_done( sub { $$r = $_[0] }); + } + } + + my $f = $slots->[$idx]; + + # Slot is non-immediate; arrange for us to be invoked again later when it's ready + if( !$f->is_ready ) { + $args[-1] = ( $return ||= $f->new ); + $f->on_done( sub { _fmap_slot( @args ) } ); + $f->on_fail( $return ); + + # Try looking for more that might be ready + my $i = $idx + 1; + while( $i != $idx ) { + $i++; + $i %= @$slots; + next if defined $slots->[$i]; + + $_[1] = $i; + redo SLOT; + } + return $return; + } + + # Either we've been invoked again (case b), or the immediate Future was + # already ready. + if( $f->failure ) { + $return ||= $f->new; + $return->fail( $f->failure ); + return $return; + } + + undef $slots->[$idx]; + # next + } +} + +sub _fmap +{ + my $code = shift; + my %args = @_; + + my $concurrent = $args{concurrent} || 1; + my @slots; + + my $results = []; + my $future = $args{return}; + + my $generator; + if( $generator = $args{generate} ) { + # OK + } + elsif( my $array = $args{foreach} ) { + $generator = sub { return unless @$array; shift @$array }; + } + else { + croak "Expected either 'generate' or 'foreach'"; + } + + # If any of these immediately fail, don't bother continuing + foreach my $idx ( 0 .. $concurrent-1 ) { + $future = _fmap_slot( \@slots, $idx, $code, $generator, $args{collect}, $results, $future ); + last if $future->is_ready; + } + + $future->on_fail( sub { + !defined $_ or $_->is_ready or $_->cancel for @slots; + }); + $future->on_cancel( sub { + $_->cancel for @slots; + }); + + return $future; +} + +=head2 $future = fmap_concat { CODE } ... + +This version of C 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 $future = fmap_scalar { CODE } ... + +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 $future = fmap_void { CODE } ... + +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; diff --git a/lib/Test/Future.pm b/lib/Test/Future.pm new file mode 100644 index 0000000..f2a7d5f --- /dev/null +++ b/lib/Test/Future.pm @@ -0,0 +1,141 @@ +# You may distribute under the terms of either the GNU General Public License +# or the Artistic License (the same terms as Perl itself) +# +# (C) Paul Evans, 2014 -- leonerd@leonerd.org.uk + +package Test::Future; + +use strict; +use warnings; +use base qw( Test::Builder::Module ); + +our $VERSION = '0.32'; + +our @EXPORT = qw( + no_pending_futures +); + +use Scalar::Util qw( refaddr ); + +use constant HAVE_DEVEL_MAT_DUMPER => defined eval { require Devel::MAT::Dumper }; + +=head1 NAME + +C - 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( \&code, $name ) + +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; diff --git a/t/00use.t b/t/00use.t new file mode 100644 index 0000000..dc88b8a --- /dev/null +++ b/t/00use.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use_ok( "Future" ); +use_ok( "Future::Utils" ); + +done_testing; diff --git a/t/01future.t b/t/01future.t new file mode 100644 index 0000000..03fb2db --- /dev/null +++ b/t/01future.t @@ -0,0 +1,290 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; +use Test::Refcount; + +use Future; + +# done +{ + my $future = Future->new; + + ok( defined $future, '$future defined' ); + isa_ok( $future, "Future", '$future' ); + is_oneref( $future, '$future has refcount 1 initially' ); + + ok( !$future->is_ready, '$future not yet ready' ); + + my @on_ready_args; + identical( $future->on_ready( sub { @on_ready_args = @_ } ), $future, '->on_ready returns $future' ); + + my @on_done_args; + identical( $future->on_done( sub { @on_done_args = @_ } ), $future, '->on_done returns $future' ); + identical( $future->on_fail( sub { die "on_fail called for done future" } ), $future, '->on_fail returns $future' ); + + identical( $future->done( result => "here" ), $future, '->done returns $future' ); + + is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' ); + identical( $on_ready_args[0], $future, 'Future passed to on_ready' ); + undef @on_ready_args; + + is_deeply( \@on_done_args, [ result => "here" ], 'Results passed to on_done' ); + + ok( $future->is_ready, '$future is now ready' ); + ok( $future->is_done, '$future is done' ); + ok( !$future->is_failed, '$future is not failed' ); + is_deeply( [ $future->get ], [ result => "here" ], 'Results from $future->get' ); + is( scalar $future->get, "result", 'Result from scalar $future->get' ); + + is_oneref( $future, '$future has refcount 1 at end of test' ); +} + +# wrap +{ + my $f = Future->new; + + my $future = Future->wrap( $f ); + + ok( defined $future, 'Future->wrap(Future) defined' ); + isa_ok( $future, "Future", 'Future->wrap(Future)' ); + + $f->done( "Wrapped Future" ); + is( scalar $future->get, "Wrapped Future", 'Future->wrap(Future)->get' ); + + $future = Future->wrap( "Plain string" ); + + ok( defined $future, 'Future->wrap(string) defined' ); + isa_ok( $future, "Future", 'Future->wrap(string)' ); + + is( scalar $future->get, "Plain string", 'Future->wrap(string)->get' ); +} + +# done_cb +{ + my $future = Future->new; + + my @on_done_args; + $future->on_done( sub { @on_done_args = @_ } ); + + my $done_cb = $future->done_cb; + is( ref $done_cb, "CODE", '->done_cb returns CODE reference' ); + + $done_cb->( result => "via cb" ); + is_deeply( \@on_done_args, [ result => "via cb" ], 'Results via ->done_cb' ); +} + +# done chaining +{ + my $future = Future->new; + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_done( $f1 ); + $future->on_ready( $f2 ); + + my @on_done_args_1; + $f1->on_done( sub { @on_done_args_1 = @_ } ); + my @on_done_args_2; + $f2->on_done( sub { @on_done_args_2 = @_ } ); + + $future->done( chained => "result" ); + + is_deeply( \@on_done_args_1, [ chained => "result" ], 'Results chained via ->on_done( $f )' ); + is_deeply( \@on_done_args_2, [ chained => "result" ], 'Results chained via ->on_ready( $f )' ); +} + +# immediately done +{ + my $future = Future->done( already => "done" ); + + my @on_done_args; + identical( $future->on_done( sub { @on_done_args = @_; } ), $future, '->on_done returns future for immediate' ); + my $on_fail; + identical( $future->on_fail( sub { $on_fail++; } ), $future, '->on_fail returns future for immediate' ); + + is_deeply( \@on_done_args, [ already => "done" ], 'Results passed to on_done for immediate future' ); + ok( !$on_fail, 'on_fail not invoked for immediate future' ); + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_done( $f1 ); + $future->on_ready( $f2 ); + + ok( $f1->is_ready, 'Chained ->on_done for immediate future' ); + ok( $f1->is_done, 'Chained ->on_done is done for immediate future' ); + is_deeply( [ $f1->get ], [ already => "done" ], 'Results from chained via ->on_done for immediate future' ); + ok( $f2->is_ready, 'Chained ->on_ready for immediate future' ); + ok( $f2->is_done, 'Chained ->on_ready is done for immediate future' ); + is_deeply( [ $f2->get ], [ already => "done" ], 'Results from chained via ->on_ready for immediate future' ); +} + +# fail +{ + my $future = Future->new; + + $future->on_done( sub { die "on_done called for failed future" } ); + my $failure; + $future->on_fail( sub { ( $failure ) = @_; } ); + + identical( $future->fail( "Something broke" ), $future, '->fail returns $future' ); + + ok( $future->is_ready, '$future->fail marks future ready' ); + ok( !$future->is_done, '$future->fail does not mark future done' ); + ok( $future->is_failed, '$future->fail marks future as failed' ); + + is( scalar $future->failure, "Something broke", '$future->failure yields exception' ); + my $file = __FILE__; + my $line = __LINE__ + 1; + like( exception { $future->get }, qr/^Something broke at \Q$file line $line\E\.?\n$/, '$future->get throws exception' ); + + is( $failure, "Something broke", 'Exception passed to on_fail' ); +} + +# fail_cb +{ + my $future = Future->new; + + my $failure; + $future->on_fail( sub { ( $failure ) = @_ } ); + + my $fail_cb = $future->fail_cb; + is( ref $fail_cb, "CODE", '->fail_cb returns CODE reference' ); + + $fail_cb->( "Failure by cb" ); + is( $failure, "Failure by cb", 'Failure via ->fail_cb' ); +} + +{ + my $future = Future->new; + + $future->fail( "Something broke", further => "details" ); + + ok( $future->is_ready, '$future->fail marks future ready' ); + + is( scalar $future->failure, "Something broke", '$future->failure yields exception' ); + is_deeply( [ $future->failure ], [ "Something broke", "further", "details" ], + '$future->failure yields details in list context' ); +} + +# fail chaining +{ + my $future = Future->new; + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_fail( $f1 ); + $future->on_ready( $f2 ); + + my $failure_1; + $f1->on_fail( sub { ( $failure_1 ) = @_ } ); + my $failure_2; + $f2->on_fail( sub { ( $failure_2 ) = @_ } ); + + $future->fail( "Chained failure" ); + + is( $failure_1, "Chained failure", 'Failure chained via ->on_fail( $f )' ); + is( $failure_2, "Chained failure", 'Failure chained via ->on_ready( $f )' ); +} + +# immediately failed +{ + my $future = Future->fail( "Already broken" ); + + my $on_done; + identical( $future->on_done( sub { $on_done++; } ), $future, '->on_done returns future for immediate' ); + my $failure; + identical( $future->on_fail( sub { ( $failure ) = @_; } ), $future, '->on_fail returns future for immediate' ); + + is( $failure, "Already broken", 'Exception passed to on_fail for already-failed future' ); + ok( !$on_done, 'on_done not invoked for immediately-failed future' ); + + my $f1 = Future->new; + my $f2 = Future->new; + + $future->on_fail( $f1 ); + $future->on_ready( $f2 ); + + ok( $f1->is_ready, 'Chained ->on_done for immediate future' ); + is_deeply( [ $f1->failure ], [ "Already broken" ], 'Results from chained via ->on_done for immediate future' ); + ok( $f2->is_ready, 'Chained ->on_ready for immediate future' ); + is_deeply( [ $f2->failure ], [ "Already broken" ], 'Results from chained via ->on_ready for immediate future' ); +} + +# die +{ + my $future = Future->new; + + $future->on_done( sub { die "on_done called for failed future" } ); + my $failure; + $future->on_fail( sub { ( $failure ) = @_; } ); + + my $file = __FILE__; + my $line = __LINE__+1; + identical( $future->die( "Something broke" ), $future, '->die returns $future' ); + + ok( $future->is_ready, '$future->die marks future ready' ); + + is( scalar $future->failure, "Something broke at $file line $line\n", '$future->failure yields exception' ); + is( exception { $future->get }, "Something broke at $file line $line\n", '$future->get throws exception' ); + + is( $failure, "Something broke at $file line $line\n", 'Exception passed to on_fail' ); +} + +# call +{ + my $future; + + $future = Future->call( sub { Future->done( @_ ) }, 1, 2, 3 ); + + ok( $future->is_ready, '$future->is_ready from immediate Future->call' ); + is_deeply( [ $future->get ], [ 1, 2, 3 ], '$future->get from immediate Future->call' ); + + $future = Future->call( sub { die "argh!\n" } ); + + ok( $future->is_ready, '$future->is_ready from immediate exception of Future->call' ); + is( $future->failure, "argh!\n", '$future->failure from immediate exception of Future->call' ); + + $future = Future->call( sub { "non-future" } ); + + ok( $future->is_ready, '$future->is_ready from non-future returning Future->call' ); + like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, + '$future->failure from non-future returning Future->call' ); +} + +# unwrap +{ + is_deeply( [ Future->unwrap( Future->done( 1, 2, 3 ) ) ], + [ 1, 2, 3 ], + 'Future->unwrap Future in list context' ); + is_deeply( [ Future->unwrap( 1, 2, 3 ) ], + [ 1, 2, 3 ], + 'Future->unwrap plain list in list context' ); + + is( scalar Future->unwrap( Future->done( qw( a b c ) ) ), + "a", + 'Future->unwrap Future in scalar context' ); + is( scalar Future->unwrap( qw( a b c ) ), + "a", + 'Future->unwrap plain list in scalar context' ); +} + +# label +{ + my $f = Future->new; + + identical( $f->set_label( "the label" ), $f, '->set_label returns $f' ); + + is( $f->label, "the label", '->label returns the label' ); + + $f->cancel; +} + +done_testing; diff --git a/t/02cancel.t b/t/02cancel.t new file mode 100644 index 0000000..bea0e3b --- /dev/null +++ b/t/02cancel.t @@ -0,0 +1,131 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; + +use Future; + +# cancel +{ + my $future = Future->new; + + my $cancelled; + + identical( $future->on_cancel( sub { $cancelled .= "1" } ), $future, '->on_cancel returns $future' ); + $future->on_cancel( sub { $cancelled .= "2" } ); + + my $ready; + $future->on_ready( sub { $ready++ if shift->is_cancelled } ); + + $future->on_done( sub { die "on_done called for cancelled future" } ); + $future->on_fail( sub { die "on_fail called for cancelled future" } ); + + $future->on_ready( my $ready_f = Future->new ); + $future->on_done( my $done_f = Future->new ); + $future->on_fail( my $fail_f = Future->new ); + + $future->cancel; + + ok( $future->is_ready, '$future->cancel marks future ready' ); + + ok( $future->is_cancelled, '$future->cancelled now true' ); + is( $cancelled, "21", '$future cancel blocks called in reverse order' ); + + is( $ready, 1, '$future on_ready still called by cancel' ); + + ok( $ready_f->is_cancelled, 'on_ready chained future cnacelled after cancel' ); + ok( !$done_f->is_ready, 'on_done chained future not ready after cancel' ); + ok( !$fail_f->is_ready, 'on_fail chained future not ready after cancel' ); + + like( exception { $future->get }, qr/cancelled/, '$future->get throws exception by cancel' ); + + ok( !exception { $future->cancel }, '$future->cancel a second time is OK' ); + + $done_f->cancel; + $fail_f->cancel; +} + +# cancel_cb +{ + my $future = Future->new; + + my $cancelled; + $future->on_cancel( sub { $cancelled++ } ); + + my $cancel_cb = $future->cancel_cb; + is( ref $cancel_cb, "CODE", '->cancel_cb returns CODE reference' ); + + $cancel_cb->(); + is( $cancelled, 1, 'Cancellation via ->cancel_cb' ); +} + +# immediately cancelled +{ + my $future = Future->new; + $future->cancel; + + my $ready_called; + $future->on_ready( sub { $ready_called++ } ); + my $done_called; + $future->on_done( sub { $done_called++ } ); + my $fail_called; + $future->on_fail( sub { $fail_called++ } ); + + $future->on_ready( my $ready_f = Future->new ); + $future->on_done( my $done_f = Future->new ); + $future->on_fail( my $fail_f = Future->new ); + + is( $ready_called, 1, 'on_ready invoked for already-cancelled future' ); + ok( !$done_called, 'on_done not invoked for already-cancelled future' ); + ok( !$fail_called, 'on_fail not invoked for already-cancelled future' ); + + ok( $ready_f->is_cancelled, 'on_ready chained future cnacelled for already-cancelled future' ); + ok( !$done_f->is_ready, 'on_done chained future not ready for already-cancelled future' ); + ok( !$fail_f->is_ready, 'on_fail chained future not ready for already-cancelled future' ); + + $done_f->cancel; + $fail_f->cancel; +} + +# cancel chaining +{ + my $f1 = Future->new; + my $f2 = Future->new; + + $f1->on_cancel( $f2 ); + my $cancelled; + $f2->on_cancel( sub { $cancelled++ } ); + + $f1->cancel; + is( $cancelled, 1, 'Chained cancellation' ); +} + +# ->done on cancelled +{ + my $f = Future->new; + $f->cancel; + + ok( eval { $f->done( "ignored" ); 1 }, '->done on cancelled future is ignored' ); + ok( eval { $f->fail( "ignored" ); 1 }, '->fail on cancelled future is ignored' ); +} + +# without_cancel +{ + my $f1 = Future->new; + my $f2 = $f1->without_cancel; + + $f2->cancel; + ok( !$f1->is_cancelled, '$f1 not cancelled just because $f2 is' ); + + my $f3 = $f1->without_cancel; + $f1->done( "result" ); + + ok( $f3->is_ready, '$f3 ready when $f1 is' ); + is_deeply( [ $f3->get ], [ "result" ], 'result of $f3' ); +} + +done_testing; diff --git a/t/03then.t b/t/03then.t new file mode 100644 index 0000000..9daea09 --- /dev/null +++ b/t/03then.t @@ -0,0 +1,290 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; +use Test::Identity; + +use Future; + +# then success +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->then( + sub { + is( $_[0], "f1 result", 'then done block passed result of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + ok( !$f2, '$f2 not yet defined before $f1 done' ); + + $f1->done( "f1 result" ); + + ok( defined $f2, '$f2 now defined after $f1 done' ); + + undef $f1; + is_oneref( $fseq, '$fseq has refcount 1 after $f1 done and dropped' ); + + ok( !$fseq->is_ready, '$fseq not yet done before $f2 done' ); + + $f2->done( results => "here" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); + + undef $f2; + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# then failure in f1 +{ + my $f1 = Future->new; + + my $fseq = $f1->then( + sub { die "then of failed Future should not be invoked" } + ); + + $f1->fail( "A failure\n" ); + + ok( $fseq->is_ready, '$fseq is now ready after $f1 fail' ); + + is( scalar $fseq->failure, "A failure\n", '$fseq fails when $f1 fails' ); +} + +# then failure in f2 +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->then( + sub { return $f2 = Future->new } + ); + + $f1->done; + $f2->fail( "Another failure\n" ); + + ok( $fseq->is_ready, '$fseq is now ready after $f2 fail' ); + + is( scalar $fseq->failure, "Another failure\n", '$fseq fails when $f2 fails' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $fseq = $f1->then( sub { + die "It fails\n"; + } ); + + ok( !defined exception { $f1->done }, 'exception not propagated from done call' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); +} + +# immediately done +{ + my $f1 = Future->done( "Result" ); + + my $f2; + my $fseq = $f1->then( + sub { return $f2 = Future->new } + ); + + ok( defined $f2, '$f2 defined for immediate done' ); + + $f2->done( "Final" ); + + ok( $fseq->is_ready, '$fseq already ready for immediate done' ); + is( scalar $fseq->get, "Final", '$fseq->get for immediate done' ); +} + +# immediately fail +{ + my $f1 = Future->fail( "Failure\n" ); + + my $fseq = $f1->then( + sub { die "then of immediately-failed future should not be invoked" } + ); + + ok( $fseq->is_ready, '$fseq already ready for immediate fail' ); + is( scalar $fseq->failure, "Failure\n", '$fseq->failure for immediate fail' ); +} + +# done fallthrough +{ + my $f1 = Future->new; + my $fseq = $f1->then; + + $f1->done( "fallthrough result" ); + + ok( $fseq->is_ready, '$fseq is ready' ); + is( scalar $fseq->get, "fallthrough result", '->then done fallthrough' ); +} + +# fail fallthrough +{ + my $f1 = Future->new; + my $fseq = $f1->then; + + $f1->fail( "fallthrough failure\n" ); + + ok( $fseq->is_ready, '$fseq is ready' ); + is( scalar $fseq->failure, "fallthrough failure\n", '->then fail fallthrough' ); +} + +# then cancel +{ + my $f1 = Future->new; + my $fseq = $f1->then( sub { die "then done of cancelled Future should not be invoked" } ); + + $fseq->cancel; + + ok( $f1->is_cancelled, '$f1 is cancelled by $fseq cancel' ); + + $f1 = Future->new; + my $f2; + $fseq = $f1->then( sub { return $f2 = Future->new } ); + + $f1->done; + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq cancel' ); +} + +# then dropping $fseq doesn't fail ->done +{ + local $SIG{__WARN__} = sub {}; + + my $f1 = Future->new; + my $fseq = $f1->then( sub { return Future->done() } ); + + undef $fseq; + + is( exception { $f1->done; }, undef, + 'Dropping $fseq does not cause $f1->done to die' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->then( + sub { Future->new } + ); + like( $warnings, + qr/^Calling ->then in void context /, + 'Warning in void context' ); +} + +# Non-Future return raises exception +{ + my $f1 = Future->new; + + my $file = __FILE__; + my $line = __LINE__+1; + my $fseq = $f1->then( sub {} ); + my $fseq2 = $f1->then( sub { Future->done } ); + + ok( !exception { $f1->done }, + '->done with non-Future return from ->then does not die' ); + + like( $fseq->failure, + qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, + 'Failure from non-Future return from ->then' ); + + ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); + + my $fseq3; + ok( !exception { $fseq3 = $f1->then( sub {} ) }, + 'non-Future return from ->then on immediate does not die' ); + + like( $fseq3->failure, + qr/^Expected __ANON__\(.*\) to return a Future/, + 'Failure from non-Future return from ->then on immediate' ); +} + +# then_with_f +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->then_with_f( + sub { + identical( $_[0], $f1, 'then_with_f block passed $f1' ); + is( $_[1], "f1 result", 'then_with_f block pased result of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + + $f1->done( "f1 result" ); + + ok( defined $f2, '$f2 defined after $f1->done' ); + + $f2->done( "f2 result" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is( scalar $fseq->get, "f2 result", '$fseq->get returns results' ); +} + +# then_done +{ + my $f1 = Future->new; + + my $fseq = $f1->then_done( second => "result" ); + + $f1->done( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->get ], [ second => "result" ], '$fseq->get returns result for then_done' ); + + my $fseq2 = $f1->then_done( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->then_done on immediate' ); + is_deeply( [ $fseq2->get ], [ third => "result" ], '$fseq2->get returns result for then_done on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->then_done( "result" ); + $f2->fail( "failure" ); + + is( scalar $fseq->failure, "failure", '->then_done ignores failure' ); +} + +# then_fail +{ + my $f1 = Future->new; + + my $fseq = $f1->then_fail( second => "result" ); + + $f1->done( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->failure ], [ second => "result" ], '$fseq->failure returns result for then_fail' ); + + my $fseq2 = $f1->then_fail( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->then_fail on immediate' ); + is_deeply( [ $fseq2->failure ], [ third => "result" ], '$fseq2->failure returns result for then_fail on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->then_fail( "fail2" ); + $f2->fail( "failure" ); + + is( scalar $fseq->failure, "failure", '->then_fail ignores failure' ); +} + +done_testing; diff --git a/t/04else.t b/t/04else.t new file mode 100644 index 0000000..2cbc546 --- /dev/null +++ b/t/04else.t @@ -0,0 +1,259 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; +use Test::Identity; + +use Future; + +# else success +{ + my $f1 = Future->new; + + my $fseq = $f1->else( + sub { die "else of successful Future should not be invoked" } + ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + $f1->done( results => "here" ); + + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq succeeds when $f1 succeeds' ); + + undef $f1; + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# else failure +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->else( + sub { + is( $_[0], "f1 failure\n", 'then fail block passed result of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + ok( !$f2, '$f2 not yet defined before $f1 fails' ); + + $f1->fail( "f1 failure\n" ); + + undef $f1; + is_oneref( $fseq, '$fseq has refcount 1 after $f1 fail and dropped' ); + + ok( defined $f2, '$f2 now defined after $f1 fails' ); + + ok( !$fseq->is_ready, '$fseq not yet done before $f2 done' ); + + $f2->done( results => "here" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); + + undef $f2; + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# Double failure +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->else( + sub { return $f2 = Future->new } + ); + + $f1->fail( "First failure\n" ); + $f2->fail( "Another failure\n" ); + + is( scalar $fseq->failure, "Another failure\n", '$fseq fails when $f2 fails' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $fseq = $f1->else( sub { + die "It fails\n"; + } ); + + ok( !defined exception { $f1->fail( "bork" ) }, 'exception not propagated from fail call' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); +} + +# immediate fail +{ + my $f1 = Future->fail( "Failure\n" ); + + my $f2; + my $fseq = $f1->else( + sub { return $f2 = Future->new } + ); + + ok( defined $f2, '$f2 defined for immediate fail' ); + + $f2->fail( "Another failure\n" ); + + ok( $fseq->is_ready, '$fseq already ready for immediate fail' ); + is( scalar $fseq->failure, "Another failure\n", '$fseq->failure for immediate fail' ); +} + +# immediate done +{ + my $f1 = Future->done( "It works" ); + + my $fseq = $f1->else( + sub { die "else block invoked for immediate done Future" } + ); + + ok( $fseq->is_ready, '$fseq already ready for immediate done' ); + is( scalar $fseq->get, "It works", '$fseq->get for immediate done' ); +} + +# else cancel +{ + my $f1 = Future->new; + my $fseq = $f1->else( sub { die "else of cancelled Future should not be invoked" } ); + + $fseq->cancel; + + ok( $f1->is_cancelled, '$f1 is cancelled by $fseq cancel' ); + + $f1 = Future->new; + my $f2; + $fseq = $f1->else( sub { return $f2 = Future->new } ); + + $f1->fail( "A failure\n" ); + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq cancel' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->else( + sub { Future->new } + ); + like( $warnings, + qr/^Calling ->else in void context /, + 'Warning in void context' ); +} + +# Non-Future return raises exception +{ + my $f1 = Future->new; + + my $file = __FILE__; + my $line = __LINE__+1; + my $fseq = $f1->else( sub {} ); + my $fseq2 = $f1->else( sub { Future->done } ); + + ok( !exception { $f1->fail( "failed\n" ) }, + '->fail with non-Future return from ->else does not die' ); + + like( $fseq->failure, + qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, + 'Failure from non-Future return from ->else' ); + + ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); + + my $fseq3; + ok( !exception { $fseq3 = $f1->else( sub {} ) }, + 'non-Future return from ->else on immediate does not die' ); + + like( $fseq3->failure, + qr/^Expected __ANON__\(.*\) to return a Future/, + 'Failure from non-Future return from ->else on immediate' ); +} + +# else_with_f +{ + my $f1 = Future->new; + + my $f2; + my $fseq = $f1->else_with_f( + sub { + identical( $_[0], $f1, 'else_with_f block passed $f1' ); + is( $_[1], "f1 failure\n", 'else_with_f block pased failure of $f1' ); + return $f2 = Future->new; + } + ); + + ok( defined $fseq, '$fseq defined' ); + + $f1->fail( "f1 failure\n" ); + + ok( defined $f2, '$f2 defined after $f1->fail' ); + + $f2->done( "f2 result" ); + + ok( $fseq->is_ready, '$fseq is done after $f2 done' ); + is( scalar $fseq->get, "f2 result", '$fseq->get returns results' ); +} + +# else_done +{ + my $f1 = Future->new; + + my $fseq = $f1->else_done( second => "result" ); + + $f1->fail( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->get ], [ second => "result" ], '$fseq->get returns result for else_done' ); + + my $fseq2 = $f1->else_done( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->else_done on immediate' ); + is_deeply( [ $fseq2->get ], [ third => "result" ], '$fseq2->get returns result for else_done on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->else_done( "result2" ); + $f2->done( "result" ); + + is( scalar $fseq->get, "result", '->else_done ignores success' ); +} + +# else_fail +{ + my $f1 = Future->new; + + my $fseq = $f1->else_fail( second => "result" ); + + $f1->fail( first => ); + + ok( $fseq->is_ready, '$fseq done after $f1 done' ); + is_deeply( [ $fseq->failure ], [ second => "result" ], '$fseq->failure returns result for else_fail' ); + + my $fseq2 = $f1->else_fail( third => "result" ); + + ok( $fseq2->is_ready, '$fseq2 done after ->else_fail on immediate' ); + is_deeply( [ $fseq2->failure ], [ third => "result" ], '$fseq2->failure returns result for else_fail on immediate' ); + + my $f2 = Future->new; + $fseq = $f2->else_fail( "failure" ); + $f2->done( "result" ); + + is( scalar $fseq->get, "result", '->else_fail ignores success' ); +} + +done_testing; diff --git a/t/05then-else.t b/t/05then-else.t new file mode 100644 index 0000000..ff35ac7 --- /dev/null +++ b/t/05then-else.t @@ -0,0 +1,78 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Future; + +# then done +{ + my $f1 = Future->new; + + my $fdone; + my $fseq = $f1->then( + sub { + is( $_[0], "f1 result", '2-arg then done block passed result of $f1' ); + return $fdone = Future->new; + }, + sub { + die "then fail block should not be invoked"; + }, + ); + + $f1->done( "f1 result" ); + + ok( defined $fdone, '$fdone now defined after $f1 done' ); + + $fdone->done( results => "here" ); + + ok( $fseq->is_ready, '$fseq is done after $fdone done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); +} + +# then fail +{ + my $f1 = Future->new; + + my $ffail; + my $fseq = $f1->then( + sub { + die "then done block should not be invoked"; + }, + sub { + is( $_[0], "The failure\n", '2-arg then fail block passed failure of $f1' ); + return $ffail = Future->new; + }, + ); + + $f1->fail( "The failure\n" ); + + ok( defined $ffail, '$ffail now defined after $f1 fail' ); + + $ffail->done( fallback => "result" ); + + ok( $fseq->is_ready, '$fseq is done after $ffail fail' ); + is_deeply( [ $fseq->get ], [ fallback => "result" ], '$fseq->get returns results' ); +} + +# then done fails doesn't trigger fail block +{ + my $f1 = Future->new; + + my $fdone; + my $fseq = $f1->then( + sub { $fdone = Future->new; }, + sub { die "then fail block should not be invoked"; }, + ); + + $f1->done( "Done" ); + $fdone->fail( "The failure\n" ); + + ok( $fseq->is_ready, '$fseq is ready after $fdone fail' ); + ok( scalar $fseq->failure, '$fseq failed after $fdone fail' ); +} + +done_testing; diff --git a/t/06followed_by.t b/t/06followed_by.t new file mode 100644 index 0000000..3c9418d --- /dev/null +++ b/t/06followed_by.t @@ -0,0 +1,197 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; +use Test::Refcount; + +use Future; + +{ + my $f1 = Future->new; + + my $called = 0; + my $fseq = $f1->followed_by( sub { + $called++; + identical( $_[0], $f1, 'followed_by block passed $f1' ); + return $_[0]; + } ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + # Two refs; one in lexical $f1, one in $fseq's cancellation closure + is_refcount( $f1, 2, '$f1 has refcount 2 initially' ); + + is( $called, 0, '$called before $f1 done' ); + + $f1->done( results => "here" ); + + is( $called, 1, '$called after $f1 done' ); + + ok( $fseq->is_ready, '$fseq is done after $f1 done' ); + is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); + + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); + is_oneref( $f1, '$f1 has refcount 1 before EOF' ); +} + +{ + my $f1 = Future->new; + + my $called = 0; + my $fseq = $f1->followed_by( sub { + $called++; + identical( $_[0], $f1, 'followed_by block passed $f1' ); + return $_[0]; + } ); + + ok( defined $fseq, '$fseq defined' ); + isa_ok( $fseq, "Future", '$fseq' ); + + is_oneref( $fseq, '$fseq has refcount 1 initially' ); + + is( $called, 0, '$called before $f1 done' ); + + $f1->fail( "failure\n" ); + + is( $called, 1, '$called after $f1 failed' ); + + ok( $fseq->is_ready, '$fseq is ready after $f1 failed' ); + is_deeply( [ $fseq->failure ], [ "failure\n" ], '$fseq->get returns failure' ); + + is_oneref( $fseq, '$fseq has refcount 1 before EOF' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $fseq = $f1->followed_by( sub { + die "It fails\n"; + } ); + + ok( !defined exception { $f1->done }, 'exception not propagated from code call' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception' ); +} + +# Cancellation +{ + my $f1 = Future->new; + + my $fseq = $f1->followed_by( + sub { die "followed_by of cancelled Future should not be invoked" } + ); + + $fseq->cancel; + + ok( $f1->is_cancelled, '$f1 cancelled by $fseq->cancel' ); + + $f1 = Future->new; + my $f2 = Future->new; + + $fseq = $f1->followed_by( sub { $f2 } ); + + $f1->done; + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel' ); + + $f1 = Future->done; + $f2 = Future->new; + + $fseq = $f1->followed_by( sub { $f2 } ); + + $fseq->cancel; + + ok( $f2->is_cancelled, '$f2 cancelled by $fseq->cancel on $f1 immediate' ); +} + +# immediately done +{ + my $f1 = Future->done; + + my $called = 0; + my $fseq = $f1->followed_by( + sub { $called++; return $_[0] } + ); + + is( $called, 1, 'followed_by block invoked immediately for already-done' ); +} + +# immediately done +{ + my $f1 = Future->fail("Failure\n"); + + my $called = 0; + my $fseq = $f1->followed_by( + sub { $called++; return $_[0] } + ); + + is( $called, 1, 'followed_by block invoked immediately for already-failed' ); +} + +# immediately code dies +{ + my $f1 = Future->done; + + my $fseq; + + ok( !defined exception { + $fseq = $f1->followed_by( sub { + die "It fails\n"; + } ); + }, 'exception not propagated from ->followed_by on immediate' ); + + ok( $fseq->is_ready, '$fseq is ready after code exception on immediate' ); + is( scalar $fseq->failure, "It fails\n", '$fseq->failure after code exception on immediate' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->followed_by( + sub { Future->new } + ); + + like( $warnings, + qr/^Calling ->followed_by in void context at /, + 'Warning in void context' ); +} + +# Non-Future return raises exception +{ + my $f1 = Future->new; + + my $file = __FILE__; + my $line = __LINE__+1; + my $fseq = $f1->followed_by( sub {} ); + my $fseq2 = $f1->followed_by( sub { Future->done } ); + + ok( !exception { $f1->done }, + '->done with non-Future return from ->followed_by does not die' ); + + like( $fseq->failure, + qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, + 'Failure from non-Future return from ->followed_by' ); + + ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); + + my $fseq3; + ok( !exception { $fseq3 = $f1->followed_by( sub {} ) }, + 'non-Future return from ->followed_by on immediate does not die' ); + + like( $fseq3->failure, + qr/^Expected __ANON__\(.*\) to return a Future/, + 'Failure from non-Future return from ->followed_by on immediate' ); +} + +done_testing; diff --git a/t/09transform.t b/t/09transform.t new file mode 100644 index 0000000..67f7e25 --- /dev/null +++ b/t/09transform.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; + +# Result transformation +{ + my $f1 = Future->new; + + my $future = $f1->transform( + done => sub { result => @_ }, + ); + + $f1->done( 1, 2, 3 ); + + is_deeply( [ $future->get ], [ result => 1, 2, 3 ], '->transform result' ); +} + +# Failure transformation +{ + my $f1 = Future->new; + + my $future = $f1->transform( + fail => sub { "failure\n" => @_ }, + ); + + $f1->fail( "something failed\n" ); + + is_deeply( [ $future->failure ], [ "failure\n" => "something failed\n" ], '->transform failure' ); +} + +# code dies +{ + my $f1 = Future->new; + + my $future = $f1->transform( + done => sub { die "It fails\n" }, + ); + + $f1->done; + + is_deeply( [ $future->failure ], [ "It fails\n" ], '->transform catches exceptions' ); +} + +# Cancellation +{ + my $f1 = Future->new; + + my $cancelled; + $f1->on_cancel( sub { $cancelled++ } ); + + my $future = $f1->transform; + + $future->cancel; + is( $cancelled, 1, '->transform cancel' ); +} + +# Void context raises a warning +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; + + Future->done->transform( + done => sub { } + ); + like( $warnings, + qr/^Calling ->transform in void context at /, + 'Warning in void context' ); +} + +done_testing; diff --git a/t/10wait_all.t b/t/10wait_all.t new file mode 100644 index 0000000..9331b61 --- /dev/null +++ b/t/10wait_all.t @@ -0,0 +1,160 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use Test::Refcount; + +use Future; + +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_all( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->wait_all' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->wait_all' ); + + is_deeply( [ $future->pending_futures ], + [ $f1, $f2 ], + '$future->pending_futures before any ready' ); + + is_deeply( [ $future->ready_futures ], + [], + '$future->done_futures before any ready' ); + + my @on_ready_args; + $future->on_ready( sub { @on_ready_args = @_ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + is( scalar @on_ready_args, 0, 'on_ready not yet invoked' ); + + $f1->done( one => 1 ); + + is_deeply( [ $future->pending_futures ], + [ $f2 ], + '$future->pending_futures after $f1 ready' ); + + is_deeply( [ $future->ready_futures ], + [ $f1 ], + '$future->ready_futures after $f1 ready' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '$future->done_futures after $f1 ready' ); + + ok( !$future->is_ready, '$future still not yet ready after f1 ready' ); + is( scalar @on_ready_args, 0, 'on_ready not yet invoked' ); + + $f2->done( two => 2 ); + + is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' ); + identical( $on_ready_args[0], $future, 'Future passed to on_ready' ); + undef @on_ready_args; + + ok( $future->is_ready, '$future now ready after f2 ready' ); + my @results = $future->get; + identical( $results[0], $f1, 'Results[0] from $future->get is f1' ); + identical( $results[1], $f2, 'Results[1] from $future->get is f2' ); + undef @results; + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f2 ready' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f2 ready' ); + + is_deeply( [ $future->done_futures ], + [ $f1, $f2 ], + '$future->done_futures after $f2 ready' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); +} + +# immediately done +{ + my $f1 = Future->done; + + my $future = Future->wait_all( $f1 ); + + ok( $future->is_ready, '$future of already-ready sub already ready' ); + my @results = $future->get; + identical( $results[0], $f1, 'Results from $future->get of already ready' ); +} + +# one immediately done +{ + my $f1 = Future->done; + my $f2 = Future->new; + + my $future = Future->wait_all( $f1, $f2 ); + + ok( !$future->is_ready, '$future of partially-done subs not yet ready' ); + + $f2->done; + + ok( $future->is_ready, '$future of completely-done subs already ready' ); + my @results = $future->get; + identical( $results[0], $f1, 'Results from $future->get of already ready' ); +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->wait_all( $f1, $f2 ); + + $f2->done; + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); + is( $c2, undef, '$future->cancel ignores ready subs' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_all( $f1, $f2 ); + + $f1->done( "result" ); + $f2->cancel; + + ok( $future->is_ready, '$future of cancelled sub is ready after final cancellation' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '->done_futures with cancellation' ); + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '->cancelled_futures with cancellation' ); +} + +# wait_all on none +{ + my $f = Future->wait_all( () ); + + ok( $f->is_ready, 'wait_all on no Futures already done' ); + is_deeply( [ $f->get ], [], '->get on empty wait_all is empty' ); +} + +done_testing; diff --git a/t/11wait_any.t b/t/11wait_any.t new file mode 100644 index 0000000..c72629e --- /dev/null +++ b/t/11wait_any.t @@ -0,0 +1,152 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Identity; +use Test::Refcount; + +use Future; + +# First done +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_any( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->wait_any' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->wait_any' ); + + is_deeply( [ $future->pending_futures ], + [ $f1, $f2 ], + '$future->pending_futures before any ready' ); + + is_deeply( [ $future->ready_futures ], + [], + '$future->done_futures before any ready' ); + + my @on_ready_args; + $future->on_ready( sub { @on_ready_args = @_ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + is( scalar @on_ready_args, 0, 'on_ready not yet invoked' ); + + $f1->done( one => 1 ); + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f1 ready' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f1 ready' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '$future->done_futures after $f1 ready' ); + + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '$future->cancelled_futures after $f1 ready' ); + + is( scalar @on_ready_args, 1, 'on_ready passed 1 argument' ); + identical( $on_ready_args[0], $future, 'Future passed to on_ready' ); + undef @on_ready_args; + + ok( $future->is_ready, '$future now ready after f1 ready' ); + is_deeply( [ $future->get ], [ one => 1 ], 'results from $future->get' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); +} + +# First fails +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_any( $f1, $f2 ); + + $f1->fail( "It fails\n" ); + + ok( $future->is_ready, '$future now ready after a failure' ); + + is( $future->failure, "It fails\n", '$future->failure yields exception' ); + + is( exception { $future->get }, "It fails\n", '$future->get throws exception' ); + + ok( $f2->is_cancelled, '$f2 cancelled after a failure' ); +} + +# immediately done +{ + my $f1 = Future->done; + + my $future = Future->wait_any( $f1 ); + + ok( $future->is_ready, '$future of already-ready sub already ready' ); +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $future = Future->wait_all( $f1 ); + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->wait_any( $f1, $f2 ); + + $f1->cancel; + + ok( !$future->is_ready, '$future not yet ready after first cancellation' ); + + $f2->done( "result" ); + + ok( $future->is_ready, '$future is ready' ); + + is_deeply( [ $future->done_futures ], + [ $f2 ], + '->done_futures with cancellation' ); + is_deeply( [ $future->cancelled_futures ], + [ $f1 ], + '->cancelled_futures with cancellation' ); + + my $f3 = Future->new; + $future = Future->wait_any( $f3 ); + + $f3->cancel; + + ok( $future->is_ready, '$future is ready after final cancellation' ); + + like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' ); +} + +# wait_any on none +{ + my $f = Future->wait_any( () ); + + ok( $f->is_ready, 'wait_any on no Futures already done' ); + is( scalar $f->failure, "Cannot ->wait_any with no subfutures", + '->get on empty wait_any is empty' ); +} + +done_testing; diff --git a/t/12needs_all.t b/t/12needs_all.t new file mode 100644 index 0000000..fe9cd36 --- /dev/null +++ b/t/12needs_all.t @@ -0,0 +1,147 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; + +use Future; + +# All done +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_all( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->needs_all' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->needs_all' ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->done( one => 1 ); + $f2->done( two => 2 ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f2 ready' ); + is_deeply( [ $future->get ], [ one => 1, two => 2 ], '$future->get after f2 ready' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); +} + +# One fails +{ + my $f1 = Future->new; + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_all( $f1, $f2 ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->fail( "It fails" ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f1 fails' ); + is( $future->failure, "It fails", '$future->failure yields exception' ); + my $file = __FILE__; + my $line = __LINE__ + 1; + like( exception { $future->get }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->get throws exception' ); + + is( $c2, 1, 'Unfinished child future cancelled on failure' ); + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f1 failure' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f1 failure' ); + + is_deeply( [ $future->done_futures ], + [], + '$future->done_futures after $f1 failure' ); + + is_deeply( [ $future->failed_futures ], + [ $f1 ], + '$future->failed_futures after $f1 failure' ); + + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '$future->cancelled_futures after $f1 failure' ); +} + +# immediately done +{ + my $future = Future->needs_all( Future->done ); + + ok( $future->is_ready, '$future of already-done sub already ready' ); +} + +# immediately fails +{ + my $future = Future->needs_all( Future->fail("F1"), Future->done ); + + ok( $future->is_ready, '$future of already-failed sub already ready' ); +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_all( $f1, $f2 ); + + $f2->done; + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); + is( $c2, undef, '$future->cancel ignores ready subs' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_all( $f1, $f2 ); + + $f1->cancel; + + ok( $future->is_ready, '$future of cancelled sub is ready after first cancellation' ); + + like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' ); +} + +# needs_all on none +{ + my $f = Future->needs_all( () ); + + ok( $f->is_ready, 'needs_all on no Futures already done' ); + is_deeply( [ $f->get ], [], '->get on empty needs_all is empty' ); +} + +done_testing; diff --git a/t/13needs_any.t b/t/13needs_any.t new file mode 100644 index 0000000..b94a762 --- /dev/null +++ b/t/13needs_any.t @@ -0,0 +1,200 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Refcount; + +use Future; + +# One done +{ + my $f1 = Future->new; + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_any( $f1, $f2 ); + is_oneref( $future, '$future has refcount 1 initially' ); + + # Two refs; one lexical here, one in $future + is_refcount( $f1, 2, '$f1 has refcount 2 after adding to ->needs_any' ); + is_refcount( $f2, 2, '$f2 has refcount 2 after adding to ->needs_any' ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->done( one => 1 ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f1 ready' ); + is_deeply( [ $future->get ], [ one => 1 ], 'results from $future->get' ); + + is_deeply( [ $future->pending_futures ], + [], + '$future->pending_futures after $f1 done' ); + + is_deeply( [ $future->ready_futures ], + [ $f1, $f2 ], + '$future->ready_futures after $f1 done' ); + + is_deeply( [ $future->done_futures ], + [ $f1 ], + '$future->done_futures after $f1 done' ); + + is_deeply( [ $future->failed_futures ], + [], + '$future->failed_futures after $f1 done' ); + + is_deeply( [ $future->cancelled_futures ], + [ $f2 ], + '$future->cancelled_futures after $f1 done' ); + + is_refcount( $future, 1, '$future has refcount 1 at end of test' ); + undef $future; + + is_refcount( $f1, 1, '$f1 has refcount 1 at end of test' ); + is_refcount( $f2, 1, '$f2 has refcount 1 at end of test' ); + + is( $c2, 1, 'Unfinished child future cancelled on failure' ); +} + +# One fails +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_any( $f1, $f2 ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->fail( "Partly fails" ); + + ok( !$future->is_ready, '$future not yet ready after $f1 fails' ); + + $f2->done( two => 2 ); + + ok( $future->is_ready, '$future now ready after $f2 done' ); + is_deeply( [ $future->get ], [ two => 2 ], '$future->get after $f2 done' ); + + is_deeply( [ $future->done_futures ], + [ $f2 ], + '$future->done_futures after $f2 done' ); + + is_deeply( [ $future->failed_futures ], + [ $f1 ], + '$future->failed_futures after $f2 done' ); +} + +# All fail +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_any( $f1, $f2 ); + + my $ready; + $future->on_ready( sub { $ready++ } ); + + ok( !$future->is_ready, '$future not yet ready' ); + + $f1->fail( "Partly fails" ); + + $f2->fail( "It fails" ); + + is( $ready, 1, '$future is now ready' ); + + ok( $future->is_ready, '$future now ready after f2 fails' ); + is( $future->failure, "It fails", '$future->failure yields exception' ); + my $file = __FILE__; + my $line = __LINE__ + 1; + like( exception { $future->get }, qr/^It fails at \Q$file line $line\E\.?\n$/, '$future->get throws exception' ); + + is_deeply( [ $future->failed_futures ], + [ $f1, $f2 ], + '$future->failed_futures after all fail' ); +} + +# immediately done +{ + my $future = Future->needs_any( Future->fail("F1"), Future->done ); + + ok( $future->is_ready, '$future of already-done sub already ready' ); +} + +# immediately fails +{ + my $future = Future->needs_any( Future->fail("F1") ); + + ok( $future->is_ready, '$future of already-failed sub already ready' ); + $future->failure; +} + +# cancel propagation +{ + my $f1 = Future->new; + my $c1; + $f1->on_cancel( sub { $c1++ } ); + + my $f2 = Future->new; + my $c2; + $f2->on_cancel( sub { $c2++ } ); + + my $future = Future->needs_all( $f1, $f2 ); + + $f2->fail( "booo" ); + + $future->cancel; + + is( $c1, 1, '$future->cancel marks subs cancelled' ); + is( $c2, undef, '$future->cancel ignores ready subs' ); +} + +# cancelled convergent +{ + my $f1 = Future->new; + my $f2 = Future->new; + + my $future = Future->needs_any( $f1, $f2 ); + + $f1->cancel; + + ok( !$future->is_ready, '$future not yet ready after first cancellation' ); + + $f2->done( "result" ); + + is_deeply( [ $future->done_futures ], + [ $f2 ], + '->done_futures with cancellation' ); + is_deeply( [ $future->cancelled_futures ], + [ $f1 ], + '->cancelled_futures with cancellation' ); + + my $f3 = Future->new; + $future = Future->needs_any( $f3 ); + + $f3->cancel; + + ok( $future->is_ready, '$future is ready after final cancellation' ); + + like( scalar $future->failure, qr/ cancelled/, 'Failure mentions cancelled' ); +} + +# needs_any on none +{ + my $f = Future->needs_any( () ); + + ok( $f->is_ready, 'needs_any on no Futures already done' ); + is( scalar $f->failure, "Cannot ->needs_any with no subfutures", + '->get on empty needs_any is empty' ); +} + +done_testing; diff --git a/t/20subclass.t b/t/20subclass.t new file mode 100644 index 0000000..9d7103d --- /dev/null +++ b/t/20subclass.t @@ -0,0 +1,138 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +# subclass->... +{ + my $f = t::Future::Subclass->new; + my @seq; + + isa_ok( $seq[@seq] = $f->then( sub {} ), + "t::Future::Subclass", + '$f->then' ); + + isa_ok( $seq[@seq] = $f->else( sub {} ), + "t::Future::Subclass", + '$f->and_then' ); + + isa_ok( $seq[@seq] = $f->then_with_f( sub {} ), + "t::Future::Subclass", + '$f->then_with_f' ); + + isa_ok( $seq[@seq] = $f->else_with_f( sub {} ), + "t::Future::Subclass", + '$f->else_with_f' ); + + isa_ok( $seq[@seq] = $f->followed_by( sub {} ), + "t::Future::Subclass", + '$f->followed_by' ); + + isa_ok( $seq[@seq] = $f->transform(), + "t::Future::Subclass", + '$f->transform' ); + + $_->cancel for @seq; +} + +# immediate->followed_by( sub { subclass } ) +{ + my $f = t::Future::Subclass->new; + my $seq; + + isa_ok( $seq = Future->done->followed_by( sub { $f } ), + "t::Future::Subclass", + 'imm->followed_by $f' ); + + $seq->cancel; +} + +# convergents +{ + my $f = t::Future::Subclass->new; + my @seq; + + isa_ok( $seq[@seq] = Future->wait_all( $f ), + "t::Future::Subclass", + 'Future->wait_all( $f )' ); + + isa_ok( $seq[@seq] = Future->wait_any( $f ), + "t::Future::Subclass", + 'Future->wait_any( $f )' ); + + isa_ok( $seq[@seq] = Future->needs_all( $f ), + "t::Future::Subclass", + 'Future->needs_all( $f )' ); + + isa_ok( $seq[@seq] = Future->needs_any( $f ), + "t::Future::Subclass", + 'Future->needs_any( $f )' ); + + my $imm = Future->done; + + isa_ok( $seq[@seq] = Future->wait_all( $imm, $f ), + "t::Future::Subclass", + 'Future->wait_all( $imm, $f )' ); + + # Pick the more derived subclass even if all are pending + + isa_ok( $seq[@seq] = Future->wait_all( Future->new, $f ), + "t::Future::Subclass", + 'Future->wait_all( Future->new, $f' ); + + $_->cancel for @seq; +} + +# empty convergents (RT97537) +{ + my $f; + + isa_ok( $f = t::Future::Subclass->wait_all(), + "t::Future::Subclass", + 'subclass ->wait_all' ); + + isa_ok( $f = t::Future::Subclass->wait_any(), + "t::Future::Subclass", + 'subclass ->wait_any' ); + $f->failure; + + isa_ok( $f = t::Future::Subclass->needs_all(), + "t::Future::Subclass", + 'subclass ->needs_all' ); + + isa_ok( $f = t::Future::Subclass->needs_any(), + "t::Future::Subclass", + 'subclass ->needs_any' ); + $f->failure; +} + +my $f_await; +{ + my $f = t::Future::Subclass->new; + + my $count = 0; + $f_await = sub { + $count++; + identical( $_[0], $f, '->await is called on $f' ); + $_[0]->done( "Result here" ) if $count == 2; + }; + + is_deeply( [ $f->get ], + [ "Result here" ], + 'Result from ->get' ); + + is( $count, 2, '$f->await called twice' ); +} + +done_testing; + +package t::Future::Subclass; +use base qw( Future ); + +sub await +{ + $f_await->( @_ ); +} diff --git a/t/21debug.t b/t/21debug.t new file mode 100644 index 0000000..8ad5508 --- /dev/null +++ b/t/21debug.t @@ -0,0 +1,83 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +BEGIN { + $ENV{PERL_FUTURE_DEBUG} = 1; +} + +use Future; + +use Time::HiRes qw( gettimeofday tv_interval ); + +my $LINE; +my $LOSTLINE; + +sub warnings(&) +{ + my $code = shift; + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= shift }; + $code->(); + $LOSTLINE = __LINE__; return $warnings; +} + +is( warnings { + my $f = Future->new; + $f->done; + }, "", 'Completed Future does not give warning' ); + +is( warnings { + my $f = Future->new; + $f->cancel; + }, "", 'Cancelled Future does not give warning' ); + +like( warnings { + $LINE = __LINE__; my $f = Future->new; + undef $f; + }, + qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) before it was ready\.?$/, + 'Lost Future raises a warning' ); + +my $THENLINE; +my $SEQLINE; +like( warnings { + $LINE = __LINE__; my $f1 = Future->new; + $THENLINE = __LINE__; my $fseq = $f1->then( sub { } ); undef $fseq; + $SEQLINE = __LINE__; $f1->done; + }, + qr/^Future=\S+ was constructed at \Q$0\E line $THENLINE and was lost near \Q$0\E line (?:$SEQLINE|$THENLINE) before it was ready\.? +Future=\S+ \(constructed at \Q$0\E line $LINE\) lost a sequence Future at \Q$0\E line $SEQLINE\.?$/, + 'Lost sequence Future raises warning' ); + +like( warnings { + $LINE = __LINE__; my $f = Future->fail("Failed!"); + undef $f; + }, + qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) with an unreported failure of: Failed!\.?/, + 'Destroyed failed future raises warning' ); + +{ + local $Future::TIMES = 1; + + my $before = [ gettimeofday ]; + + my $future = Future->new; + + ok( defined $future->btime, '$future has btime with $TIMES=1' ); + ok( tv_interval( $before, $future->btime ) >= 0, '$future btime is not earlier than $before' ); + + $future->done; + + ok( defined $future->rtime, '$future has rtime with $TIMES=1' ); + ok( tv_interval( $future->btime, $future->rtime ) >= 0, '$future rtime is not earlier than btime' ); + ok( tv_interval( $future->rtime ) >= 0, '$future rtime is not later than now' ); + + ok( defined $future->elapsed, '$future has ->elapsed time' ); + ok( $future->elapsed >= 0, '$future elapsed time >= 0' ); +} + +done_testing; diff --git a/t/22wrap_cb.t b/t/22wrap_cb.t new file mode 100644 index 0000000..cdd6a59 --- /dev/null +++ b/t/22wrap_cb.t @@ -0,0 +1,105 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; + +our $VAR = ""; +# around Future::wrap_cb => sub { ... } +{ + my $orig = Future->can( 'wrap_cb' ); + no warnings 'redefine'; + *Future::wrap_cb = sub { + my $cb = $orig->(@_); + my $saved_VAR = $VAR; + + return sub { + local $VAR = $saved_VAR; + $cb->(@_); + }; + }; +} + +# on_ready +{ + my $result; + my $f = Future->new; + + { + local $VAR = "inner"; + $f->on_ready( sub { $result = $VAR } ); + } + + $f->done; + + is( $result, "inner", 'on_ready wraps CB' ); +} + +# on_done +{ + my $result; + my $f = Future->new; + + { + local $VAR = "inner"; + $f->on_done( sub { $result = $VAR } ); + } + + $f->done; + + is( $result, "inner", 'on_done wraps CB' ); +} + +# on_fail +{ + my $result; + my $f = Future->new; + + { + local $VAR = "inner"; + $f->on_fail( sub { $result = $VAR } ); + } + + $f->fail( "Failed" ); + + is( $result, "inner", 'on_fail wraps CB' ); +} + +# then +{ + my $result; + my $f = Future->new; + + my $f2; + { + local $VAR = "inner"; + $f2 = $f->then( sub { $result = $VAR; Future->done } ); + } + + $f->done; + + is( $result, "inner", 'then wraps CB' ); +} + +# else +{ + my $result; + my $f = Future->new; + + my $f2; + { + local $VAR = "inner"; + $f2 = $f->else( sub { $result = $VAR; Future->done } ); + } + + $f->fail( "Failed" ); + + is( $result, "inner", 'else wraps CB' ); +} + +# Other sequence methods all use the same ->_sequence so all should be fine + +done_testing; diff --git a/t/30utils-call.t b/t/30utils-call.t new file mode 100644 index 0000000..221d302 --- /dev/null +++ b/t/30utils-call.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +use Future; +use Future::Utils qw( call ); + +# call returns future +{ + my $ret_f; + my $f = call { + return $ret_f = Future->new; + }; + + identical( $f, $ret_f, 'call() returns future returned from its code' ); + $f->cancel; +} + +# call returns immediate failure on die +{ + my $f = call { + die "argh!\n"; + }; + + ok( $f->is_ready, 'call() returns immediate future on die' ); + is( scalar $f->failure, "argh!\n", 'failure from immediate future on die' ); +} + +# call returns immediate failure on non-Future return +{ + my $f = call { + return "non-future"; + }; + + ok( $f->is_ready, 'call() returns immediate future on non-future return' ); + like( scalar $f->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, + 'failure from immediate future on non-future return' ); +} + +done_testing; diff --git a/t/31utils-call-with-escape.t b/t/31utils-call-with-escape.t new file mode 100644 index 0000000..973900c --- /dev/null +++ b/t/31utils-call-with-escape.t @@ -0,0 +1,70 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; + +use Future; +use Future::Utils qw( call_with_escape ); + +# call_with_escape normal return +{ + my $ret_f; + my $f = call_with_escape { + return $ret_f = Future->new; + }; + + $ret_f->done( "result" ); + + ok( $f->is_ready, 'call_with_escape ready after returned future ready' ); + is( scalar $f->get, "result", 'result of call_with_escape' ); + + $f = call_with_escape { + return $ret_f = Future->new; + }; + + $ret_f->fail( "failure" ); + + ok( $f->is_ready, 'call_with_escape ready after returned future ready' ); + is( scalar $f->failure, "failure", 'result of call_with_escape' ); + + undef $ret_f; + is_oneref( $f, 'call_with_escape has refcount 1 before EOF' ); +} + +# call_with_escape synchronous escape +{ + my $f = call_with_escape { + my $escape = shift; + $escape->done( "escaped" ); + }; + + ok( $f->is_ready, 'call_with_escape ready after synchronous escape' ); + is( scalar $f->get, "escaped", 'result of call_with_escape' ); +} + +# call_with_escape delayed escape +{ + my $ret_f = Future->new; + my $inner_f; + + my $f = call_with_escape { + my $escape = shift; + return $inner_f = $ret_f->then( sub { + return $escape->done( "later escape" ); + }); + }; + + ok( !$f->is_ready, 'call_with_escape not yet ready before deferral' ); + + $ret_f->done; + + ok( $f->is_ready, 'call_with_escape ready after deferral' ); + is( scalar $f->get, "later escape", 'result of call_with_escape' ); + + ok( $inner_f->is_cancelled, 'code-returned future cancelled after escape' ); +} + +done_testing; diff --git a/t/32utils-repeat.t b/t/32utils-repeat.t new file mode 100644 index 0000000..4ee03ce --- /dev/null +++ b/t/32utils-repeat.t @@ -0,0 +1,188 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +use Future; +use Future::Utils qw( repeat try_repeat try_repeat_until_success ); + +{ + my $trial_f; + my $previous_trial; + my $arg; + my $again; + my $future = repeat { + $previous_trial = shift; + return $trial_f = Future->new + } while => sub { $arg = shift; $again }; + + ok( defined $future, '$future defined for repeat while' ); + + ok( defined $trial_f, 'An initial future is running' ); + + my $first_f = $trial_f; + + $again = 1; + $trial_f->done( "one" ); + + ok( defined $arg, '$arg defined for while test' ); + is( scalar $arg->get, "one", '$arg->get for first' ); + + identical( $previous_trial, $first_f, 'code block is passed previous trial' ); + + $again = 0; + $trial_f->done( "two" ); + + ok( $future->is_ready, '$future is now ready after second attempt ->done' ); + is( scalar $future->get, "two", '$future->get' ); +} + +# return keyword +{ + my $trial_f; + my $future = repeat { + return $trial_f = Future->new + } while => sub { 1 }, return => my $ret = Future->new; + + identical( $future, $ret, 'repeat with return yields correct instance' ); +} + +# cancellation +{ + my @running; my $i = 0; + my $future = repeat { + return $running[$i++] = Future->new + } while => sub { 1 }; + + ok( defined $future, '$future defined for repeat while' ); + + ok( defined $running[0], 'An initial future is running' ); + + $running[0]->done; + + $future->cancel; + + ok( !$running[0]->is_cancelled, 'previously running future not cancelled' ); + ok( $running[1]->is_cancelled, 'running future cancelled after eventual is cancelled' ); + ok( !$running[2], 'a third trial is not started' ); +} + +# until +{ + my $trial_f; + my $arg; + my $accept; + my $future = repeat { + return $trial_f = Future->new + } until => sub { $arg = shift; $accept }; + + ok( defined $future, '$future defined for repeat until' ); + + ok( defined $trial_f, 'An initial future is running' ); + + $accept = 0; + $trial_f->done( "three" ); + + ok( defined $arg, '$arg defined for while test' ); + is( scalar $arg->get, "three", '$arg->get for first' ); + + $accept = 1; + $trial_f->done( "four" ); + + ok( $future->is_ready, '$future is now ready after second attempt ->done' ); + is( scalar $future->get, "four", '$future->get' ); +} + +# body code dies +{ + my $future; + + $future = repeat { + die "It failed\n"; + } while => sub { !shift->failure }; + + is( $future->failure, "It failed\n", 'repeat while failure after code exception' ); + + $future = repeat { + die "It failed\n"; + } until => sub { shift->failure }; + + is( $future->failure, "It failed\n", 'repeat until failure after code exception' ); +} + +# condition code dies (RT100067) +{ + my $future = repeat { + Future->done(1); + } while => sub { die "it dies!\n" }; + + is( $future->failure, "it dies!\n", 'repeat while failure after condition exception' ); +} + +# Non-Future return fails +{ + my $future; + + $future = repeat { + "non-Future" + } while => sub { !shift->failure }; + + like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, + 'repeat failure for non-Future return' ); +} + +# try_repeat catches failures +{ + my $attempt = 0; + my $future = try_repeat { + if( ++$attempt < 3 ) { + return FUture->new->fail( "Too low" ); + } + else { + return Future->done( $attempt ); + } + } while => sub { shift->failure }; + + ok( $future->is_ready, '$future is now ready for try_repeat' ); + is( scalar $future->get, 3, '$future->get' ); +} + +{ + my $attempt = 0; + my $future = try_repeat_until_success { + if( ++$attempt < 3 ) { + return Future->fail( "Too low" ); + } + else { + return Future->done( $attempt ); + } + }; + + ok( $future->is_ready, '$future is now ready for try_repeat_until_success' ); + is( scalar $future->get, 3, '$future->get' ); +} + +# repeat prints a warning if asked to retry a failure +{ + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= join "", @_ }; + + my $attempt = 0; + my $future = repeat { + if( ++$attempt < 3 ) { + return Future->fail( "try again" ); + } + else { + return Future->done( "OK" ); + } + } while => sub { $_[0]->failure }; + + ok( $future->is_ready, '$future is now ready after repeat retries failures' ); + like( $warnings, qr/(?:^Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead at \Q$0\E line \d+\.?$)+/m, + 'Warnings printing by repeat retries failures' ); +} + +done_testing; diff --git a/t/33utils-repeat-generate.t b/t/33utils-repeat-generate.t new file mode 100644 index 0000000..72410fb --- /dev/null +++ b/t/33utils-repeat-generate.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; +use Future::Utils qw( repeat ); + +# generate without otherwise +{ + my $trial_f; + my $arg; + + my $i = 0; + my $future = repeat { + $arg = shift; + return $trial_f = Future->new; + } generate => sub { $i < 3 ? ++$i : () }; + + is( $arg, 1, '$arg 1 for first iteration' ); + $trial_f->done; + + ok( !$future->is_ready, '$future not ready' ); + + is( $arg, 2, '$arg 2 for second iteratoin' ); + $trial_f->done( "not yet" ); + + ok( !$future->is_ready, '$future still not ready' ); + + is( $arg, 3, '$arg 3 for third iteration' ); + $trial_f->done( "result" ); + + ok( $future->is_ready, '$future now ready' ); + is( scalar $future->get, "result", '$future->get' ); +} + +# generate otherwise +{ + my $last_trial_f; + my $i = 0; + my $future = repeat { + Future->done( "ignore me $_[0]" ); + } generate => sub { $i < 3 ? ++$i : () }, + otherwise => sub { + $last_trial_f = shift; + return Future->fail( "Nothing succeeded\n" ); + }; + + is( scalar $future->failure, "Nothing succeeded\n", '$future returns otherwise failure' ); + is( scalar $last_trial_f->get, "ignore me 3", '$last_trial_f->get' ); + + $future = repeat { + Future->done( "ignore me" ); + } generate => sub { () }, + otherwise => sub { Future->fail( "Nothing to do\n" ) }; + + is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty generator' ); +} + +# Probably don't need much more testing since most combinations are test with +# foreach - while/until, die, etc.. + +done_testing; diff --git a/t/34utils-repeat-foreach.t b/t/34utils-repeat-foreach.t new file mode 100644 index 0000000..94d70d6 --- /dev/null +++ b/t/34utils-repeat-foreach.t @@ -0,0 +1,152 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; +use Future::Utils qw( repeat try_repeat try_repeat_until_success ); + +# foreach without otherwise +{ + my $trial_f; + my $arg; + my $future = repeat { + $arg = shift; + return $trial_f = Future->new; + } foreach => [qw( one two three )]; + + is( $arg, "one", '$arg one for first iteration' ); + $trial_f->done; + + ok( !$future->is_ready, '$future not ready' ); + + is( $arg, "two", '$arg two for second iteration' ); + $trial_f->done( "another" ); + + ok( !$future->is_ready, '$future not ready' ); + + is( $arg, "three", '$arg three for third iteration' ); + $trial_f->done( "result" ); + + ok( $future->is_ready, '$future now ready' ); + is( scalar $future->get, "result", '$future->get' ); +} + +# foreach otherwise +{ + my $last_trial_f; + my $future = repeat { + Future->done( "ignore me $_[0]" ); + } foreach => [qw( one two three )], + otherwise => sub { + $last_trial_f = shift; + return Future->fail( "Nothing succeeded\n" ); + }; + + is( scalar $future->failure, "Nothing succeeded\n", '$future returns otherwise failure' ); + is( scalar $last_trial_f->get, "ignore me three", '$last_trial_f->get' ); + + $future = repeat { + Future->done( "ignore me" ); + } foreach => [], + otherwise => sub { Future->fail( "Nothing to do\n" ) }; + + is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty list' ); +} + +# foreach on empty list +{ + my $future = repeat { die "Not invoked" } foreach => []; + + ok( $future->is_ready, 'repeat {} on empty foreach without otherwise already ready' ); + is_deeply( [ $future->get ], [], 'Result of empty future' ); + + $future = repeat { die "Not invoked" } foreach => [], + otherwise => sub { Future->done( 1, 2, 3 ) }; + + ok( $future->is_ready, 'repeat {} on empty foreach with otherwise already ready' ); + is_deeply( [ $future->get ], [ 1, 2, 3 ], 'Result of otherwise future' ); +} + +# foreach while +{ + my $future = try_repeat { + my $arg = shift; + if( $arg eq "bad" ) { + return Future->fail( "bad" ); + } + else { + return Future->done( $arg ); + } + } foreach => [qw( bad good not-attempted )], + while => sub { shift->failure }; + + is( scalar $future->get, "good", '$future->get returns correct result for foreach+while' ); +} + +# foreach until +{ + my $future = try_repeat { + my $arg = shift; + if( $arg eq "bad" ) { + return Future->fail( "bad" ); + } + else { + return Future->done( $arg ); + } + } foreach => [qw( bad good not-attempted )], + until => sub { !shift->failure }; + + is( scalar $future->get, "good", '$future->get returns correct result for foreach+until' ); +} + +# foreach while + otherwise +{ + my $future = repeat { + Future->done( $_[0] ); + } foreach => [ 1, 2, 3 ], + while => sub { $_[0]->get < 2 }, + otherwise => sub { Future->fail( "Failed to find 2" ) }; + + is( scalar $future->get, 2, '$future->get returns successful result from while + otherwise' ); +} + +# try_repeat_until_success foreach +{ + my $future = try_repeat_until_success { + my $arg = shift; + if( $arg eq "bad" ) { + return Future->fail( "bad" ); + } + else { + return Future->done( $arg ); + } + } foreach => [qw( bad good not-attempted )]; + + is( scalar $future->get, "good", '$future->get returns correct result for try_repeat_until_success' ); +} + +# main code dies +{ + my $future = try_repeat { + $_[1]->failure if @_ > 1; # absorb the previous failure + + die "It failed\n"; + } foreach => [ 1, 2, 3 ]; + + is( $future->failure, "It failed\n", 'repeat foreach failure after code exception' ); +} + +# otherwise code dies +{ + my $future = repeat { + Future->done; + } foreach => [], + otherwise => sub { die "It failed finally\n" }; + + is( $future->failure, "It failed finally\n", 'repeat foreach failure after otherwise exception' ); +} + +done_testing; diff --git a/t/35utils-map-void.t b/t/35utils-map-void.t new file mode 100644 index 0000000..3f62e5f --- /dev/null +++ b/t/35utils-map-void.t @@ -0,0 +1,200 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; + +use Future; +use Future::Utils qw( fmap_void ); + +# fmap_void from ARRAY, no concurrency +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ]; + + ok( defined $future, '$future defined for fmap non-concurrent' ); + + ok( defined $subf[0], '$subf[0] defined' ); + ok( !defined $subf[1], '$subf[1] not yet defined' ); + + $subf[0]->done; + + ok( defined $subf[1], '$subf[1] defined after $subf[0] done' ); + + $subf[1]->done; + + $subf[2]->done; + + ok( $future->is_ready, '$future now ready after subs done' ); + is_deeply( [ $future->get ], [], '$future->get empty for fmap_void' ); +} + +# fmap_void from CODE +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new + } generate => do { my $count = 0; + sub { return unless $count < 3; $count++ } }; + + ok( defined $future, '$future defined for fmap non-concurrent from CODE' ); + + ok( defined $subf[0], '$subf[0] defined' ); + + $subf[0]->done; + $subf[1]->done; + $subf[2]->done; + + ok( $future->is_ready, '$future now ready after subs done from CODE' ); +} + +# fmap_void concurrent +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 4 ], + concurrent => 2; + + ok( defined $future, '$future defined for fmap concurrent=2' ); + + ok( defined $subf[0], '$subf[0] defined' ); + ok( defined $subf[1], '$subf[1] defined' ); + + $subf[0]->done; $subf[1]->done; + + ok( defined $subf[2], '$subf[2] defined' ); + ok( defined $subf[3], '$subf[3] defined' ); + + $subf[2]->done; $subf[3]->done; + + ok( defined $subf[4], '$subf[4] deifned' ); + ok( !$future->is_ready, '$future not yet ready while one sub remains' ); + + $subf[4]->done; + + ok( $future->is_ready, '$future now ready after concurrent subs done' ); +} + +# fmap_void late-addition concurrently +{ + my @items = ( 1, 2, 3 ); + my @subf; + my $future = fmap_void { + my $val = shift; + my $f = $subf[$val] = Future->new; + $f->on_done( sub { push @items, 4, 5, 6 } ) if $val == 3; + $f + } foreach => \@items, + concurrent => 4; + + ok( defined $future, '$future defined for fmap concurrent=3 late-add' ); + + ok( $subf[1] && $subf[2] && $subf[3], '3 subfutures initally ready' ); + + $subf[1]->done; + $subf[2]->done; + + ok( !$subf[4], 'No $subf[4] before $subf[3] done' ); + + $subf[3]->done; + + ok( $subf[4] && $subf[5] && $subf[6], '3 new subfutures now ready' ); + + $subf[4]->done; + $subf[5]->done; + $subf[6]->done; + + ok( $future->is_ready, '$future now ready after all 6 subfutures done' ); +} + +# fmap_void on immediates +{ + my $future = fmap_void { + return Future->done + } foreach => [ 0 .. 2 ]; + + ok( $future->is_ready, '$future already ready for fmap on immediates' ); +} + +# fmap_void on non/immediate mix +{ + my @item_f = ( my $item = Future->new, Future->done, Future->done ); + my $future = fmap_void { + return $_[0]; + } foreach => \@item_f, + concurrent => 2; + + ok( !$future->is_ready, '$future not yet ready before non-immediate done' ); + + $item->done; + ok( $future->is_ready, '$future now ready after non-immediate done' ); +} + +# fmap_void fail +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new; + } foreach => [ 0, 1, 2 ], + concurrent => 2; + + ok( !$subf[0]->is_cancelled, '$subf[0] not cancelled before failure' ); + + $subf[1]->fail( "failure" ); + + ok( $subf[0]->is_cancelled, '$subf[0] now cancelled after $subf[1] failure' ); + ok( $future->is_ready, '$future now ready after $sub[1] failure' ); + is( scalar $future->failure, "failure", '$future->failure after $sub[1] failure' ); + ok( !defined $subf[2], '$subf[2] was never started after $subf[1] failure' ); +} + +# fmap_void immediate fail +{ + my @subf; + my $future = fmap_void { + if( $_[0] eq "fail" ) { + return Future->fail( "failure" ); + } + else { + $subf[$_[0]] = Future->new; + } + } foreach => [ 0, "fail", 2 ], + concurrent => 3; + + ok( $future->is_ready, '$future is already ready' ); + is( scalar $future->failure, "failure", '$future->failure after immediate failure' ); + + ok( $subf[0]->is_cancelled, '$subf[0] is cancelled after immediate failure' ); + ok( !defined $subf[2], '$subf[2] was never started after immediate failure' ); +} + +# fmap_void cancel +{ + my @subf; + my $future = fmap_void { + return $subf[$_[0]] = Future->new; + } foreach => [ 0, 1, 2 ], + concurrent => 2; + + $future->cancel; + + ok( $subf[0]->is_cancelled, '$subf[0] now cancelled after ->cancel' ); + ok( $subf[1]->is_cancelled, '$subf[1] now cancelled after ->cancel' ); + ok( !defined $subf[2], '$subf[2] was never started after ->cancel' ); +} + +# fmap_void return +{ + my $future = fmap_void { + return Future->done; + } foreach => [ 0 ], return => my $ret = Future->new; + + identical( $future, $ret, 'repeat with return yields correct instance' ); +} + +done_testing; diff --git a/t/36utils-map.t b/t/36utils-map.t new file mode 100644 index 0000000..a19c43c --- /dev/null +++ b/t/36utils-map.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future; +use Future::Utils qw( fmap_concat fmap_scalar ); + +# fmap_concat no concurrency +{ + my @subf; + my $future = fmap_concat { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ]; + + my @results; + $future->on_done( sub { @results = @_ }); + + $subf[0]->done( "A", "B" ); + $subf[1]->done( "C", "D", ); + $subf[2]->done( "E" ); + + ok( $future->is_ready, '$future now ready after subs done for fmap_concat' ); + is_deeply( [ $future->get ], [qw( A B C D E )], '$future->get for fmap_concat' ); + is_deeply( \@results, [qw( A B C D E )], '@results for fmap_concat' ); +} + +# fmap_concat concurrent +{ + my @subf; + my $future = fmap_concat { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ], + concurrent => 3; + + # complete out of order + $subf[0]->done( "A", "B" ); + $subf[2]->done( "E" ); + $subf[1]->done( "C", "D" ); + + is_deeply( [ $future->get ], [qw( A B C D E )], '$future->get for fmap_concat out of order' ); +} + +# fmap_scalar no concurrency +{ + my @subf; + my $future = fmap_scalar { + return $subf[$_[0]] = Future->new + } foreach => [ 0 .. 2 ]; + + my @results; + $future->on_done( sub { @results = @_ }); + + $subf[0]->done( "A" ); + $subf[1]->done( "B" ); + $subf[2]->done( "C" ); + + ok( $future->is_ready, '$future now ready after subs done for fmap_scalar' ); + is_deeply( [ $future->get ], [qw( A B C )], '$future->get for fmap_scalar' ); + is_deeply( \@results, [qw( A B C )], '@results for fmap_scalar' ); +} + +done_testing; diff --git a/t/50test-future.t b/t/50test-future.t new file mode 100644 index 0000000..326066e --- /dev/null +++ b/t/50test-future.t @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; +use Test::Builder::Tester; + +use Future; +use Test::Future; + +# pass +{ + test_out( "ok 1 - immediate Future" ); + + my $ran_code; + no_pending_futures { + $ran_code++; + Future->done(1,2,3); + } 'immediate Future'; + + test_test( "immediate Future passes" ); + ok( $ran_code, 'actually ran the code' ); +} + +# fail +{ + test_out( "not ok 1 - pending Future" ); + test_fail( +8 ); + test_err( "# The following Futures are still pending:" ); + test_err( qr/^# 0x[0-9a-f]+\n/ ); + test_err( qr/^# Writing heap dump to \S+\n/ ) if Test::Future::HAVE_DEVEL_MAT_DUMPER; + + my $f; + no_pending_futures { + $f = Future->new; + } 'pending Future'; + + test_test( "pending Future fails" ); + + $f->cancel; +} + +# does not retain Futures +{ + test_out( "ok 1 - refcount 2 before drop" ); + test_out( "ok 2 - refcount 1 after drop" ); + test_out( "ok 3 - retain" ); + + no_pending_futures { + my $arr = [1,2,3]; + my $f = Future->new; + $f->done( $arr ); + is_refcount( $arr, 2, 'refcount 2 before drop' ); + undef $f; + is_refcount( $arr, 1, 'refcount 1 after drop' ); + } 'retain'; + + test_test( "no_pending_futures does not retain completed Futures" ); +} + +# does not retain immedate Futures +{ + test_out( "ok 1 - refcount 2 before drop" ); + test_out( "ok 2 - refcount 1 after drop" ); + test_out( "ok 3 - retain" ); + + no_pending_futures { + my $arr = [1,2,3]; + my $f = Future->done( $arr ); + is_refcount( $arr, 2, 'refcount 2 before drop' ); + undef $f; + is_refcount( $arr, 1, 'refcount 1 after drop' ); + } 'retain'; + + test_test( "no_pending_futures does not retain immediate Futures" ); +} + +END { + # Clean up Devel::MAT dumpfile + my $pmat = $0; + $pmat =~ s/\.t$/-1.pmat/; + unlink $pmat if -f $pmat; +} + +done_testing; diff --git a/t/99pod.t b/t/99pod.t new file mode 100644 index 0000000..eb319fb --- /dev/null +++ b/t/99pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +all_pod_files_ok(); -- cgit v1.2.1