Future-0.23000755001750001750 012266767434 11452 5ustar00leoleo000000000000Future-0.23/Changes000444001750001750 1600012266767434 13117 0ustar00leoleo000000000000Revision history for Future 0.23 2013/01/19 15:26:55 [CHANGES] * Link to Futures advent calendar 2013 * Fixes/additions to Phrasebook documentation, including section about tree recursion [BUGFIXES] * Ensure that late addition of additional items to a fmap foreach array works correctly even with concurrency 0.22 2014/01/12 03:12:18 [CHANGES] * Ignore ->done or ->fail on cancelled Futures * Added ->then_done, ->then_fail, ->else_done, ->else_fail * Neaten up naming of fmap* family - provide both long and short names for each function * Added Future::Utils::call and call_with_escape * Ensure that dependent futures on subclasses tries to use derived futures as prototype if possible 0.21 2013/12/29 18:14:41 [CHANGES] * Major performance improvement by folding out some layers of sub {} wrapping in sequencing operations * Added ->then_with_f and ->else_with_f [BUGFIXES] * Don't start another trial after cancelling a repeat() (RT91147) 0.20 2013/11/18 19:14:27 [CHANGES] * Include an indication of done/failed/cancelled status of a Future when ->done or ->failing an already-ready one [BUGFIXES] * Declare requires perl 5.8 because it fails on 5.6 smokers - no idea why * Fix a couple of typoes in docs (RT89185) 0.19 2013/09/27 13:31:16 [BUGFIXES] * Guard against odd things happening during ->cancel at global destruction (RT88967) 0.18 2013/09/20 19:09:57 [CHANGES] * Added 'try_repeat' and 'try_repeat_until_success' aliases * @CARP_NOT trust between Future and Future::Utils [BUGFIXES] * Fix to concurrent non-immediate + immediate fmap* return values 0.17 2013/09/07 16:53:47 [CHANGES] * Performance improvement by using direct member access instead of accessor methods * Documentation updates; suggestion of documentation style for Future-returning code [BUGFIXES] * Respect subclassing of immediate->followed_by and dependent futures with mixed subclass or immediate components 0.16 CHANGES: * Proper behaviour of ->wait_all and ->needs_all on an empty list - just return empty immediate done * Proper behaviour of ->wait_any and ->needs_any on an empty list - return an immediate failure * Performance improvement to ->done for immediate Future->new->done * Keep a count of pending child futures to avoid quadratic behaviour due to linear scan of children every time one completes * Improve efficiency of Future::Utils::repeat and fmap* when trials return immediates * Make repeat and fmap* 'return' argument optional by cloning the first non-immediate trial * Rework unit tests to avoid dependency on Test::Warn 0.15 CHANGES: * Added Future->call constructor * Fixed reference-retaining bug in Future's on_cancel callback list * Ensure that ->cancel returns $self even on immediates * Documentation updates to mention ->wrap and ->call, and the fmap family 0.14 CHANGES: * Added Future->wrap constructor * Added Future::Utils::fmap* family of functions BUGFIXES: * Fixed a precedence bug in 'and' vs && 0.13 CHANGES: * Added ->then and ->else methods; like ->and_then but code is passed result directly instead of invocant future * Added repeat { ... } foreach, otherwise argument to set final result and also handle empty lists * Added repeat { ... } generate * Turn repeat { ... } code block exceptions into failed futures * Ensure that ->on_cancel returns $self (RT85134) * Documentation / Phrasebook updates to demonstrate newly added features 0.12 CHANGES: * Take a 'return' argument to Future::Utils::repeat; deprecate the trial-cloning feature for subclasses * Have ->followed_by/etc... print a warning in void context * Throw an exception when ->followed_by/etc.. code does not yield a Future (RT84188) * Ensure that ->needs_all/->needs_any work correctly on a mix of immediate and pending Futures (RT84187) * Ensure that ->on_done/->on_fail always return invocant (RT84313) * Ensure that ->on_ready($f) works on cancelled Futures (RT84312) 0.11 CHANGES: * Added Future::Phrasebook documentation file * Ensure that exceptions thrown from ->followed_by code block are caught and turned into failed Futures * Fix filename regexp matches for unit-tests so they work on Windows 0.10 BUGFIXES: * Account for newer Carp version in unit tests, which appends trailing period to messages 0.09 CHANGES: * Split ->fail method into new ->die call, only append caller file/line to the exception in the latter * Various documentation and example improvements 0.08 CHANGES: * Ignore attempts to cancel already-complete or already-cancelled futures, or to attach ->on_cancel callbacks to them * $future->get should return the first result in scalar context * Added Future::Utils with repeat { ...} and repeat_until_success { ... } looping constructs * Link to LPW2012 talk slides 0.07 CHANGES: * Leak debugging 0.06 CHANGES: * Remembered to actually include the example scripts. No other actual code changes. 0.05 CHANGES: * Respect subclassing by allowing ->new on instances * Allow subclasses to provide an ->await method which will be used by ->get and ->failure * Added some example scripts to demonstrate how to use Futures with various event systems 0.04 CHANGES: * Fix implementation of sequenced futures to work properly on immediates * Ensure that future->future chaining via callbacks works correctly on immediates * Link to "curry" in the docs about CODE-returning convenience accessors ->done_cb, ->fail_cb and ->cancel_cb 0.03 INCOMPATIBLE CHANGES: * Future->needs_all and Future->needs_any now return dependents' results CHANGES: * Removed $future->( ... ) callable override * Pass $f1 to ->or_else code block by symmetry with ->and_then * Added $f->followed_by * Added Future->wait_any dependent future constructor * Rearranged documentation and added more examples 0.02 CHANGES: * Rearranged non-leaf future logic * Added {pending,ready,done,failed,cancelled}_futures accessors * Added Future->needs_any constructor 0.01 First version, released on an unsuspecting world. Future-0.23/META.json000444001750001750 204712266767434 13233 0ustar00leoleo000000000000{ "abstract" : "represent an operation awaiting completion", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4202", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Future", "prereqs" : { "build" : { "requires" : { "Test::Fatal" : "0", "Test::Identity" : "0", "Test::More" : "0.88", "Test::Refcount" : "0" } }, "runtime" : { "requires" : { "perl" : "5.008" } } }, "provides" : { "Future" : { "file" : "lib/Future.pm", "version" : "0.23" }, "Future::Utils" : { "file" : "lib/Future/Utils.pm", "version" : "0.23" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.23" } Future-0.23/README000444001750001750 7045512266767434 12522 0ustar00leoleo000000000000NAME `Future' - represent an operation awaiting completion SYNOPSIS my $future = Future->new; perform_some_operation( on_complete => sub { $future->done( @_ ); } ); $future->on_ready( sub { say "The operation is complete"; } ); DESCRIPTION A `Future' object represents an operation that is currently in progress, or has recently completed. It can be used in a variety of ways to manage the flow of control, and data, through an asynchronous program. Some futures represent a single operation and are explicitly marked as ready by calling the `done' or `fail' methods. These are called "leaf" futures here, and are returned by the `new' constructor. Other futures represent a collection sub-tasks, and are implicitly marked as ready depending on the readiness of their component futures as required. These are called "dependent" futures here, and are 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. 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. This feature is enabled by setting an environment variable called `PERL_FUTURE_DEBUG' to some true value. $ 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 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->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. $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 dependent future. Returns the `$future' to allow easy chaining to create an immediate future by return Future->new->done( ... ) 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. $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. The same effect can be achieved using curry: $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'. Returns the `$future' to allow easy chaining to create an immediate failed future by return Future->new->fail( ... ) 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. $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. The same effect can be achieved using curry: $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 dependent 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 dependent 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. $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. $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 dependent 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. The same effect can be achieved using curry: $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->and_then( \&code ) An older form of `then_with_f'; this method passes only the original future itself to the code, not its result. The code would have to call `get' on the future to obtain the result. $f2 = $code->( $f1 ) This method may be removed in a later version; use `then_with_f' in new code. $future = $f1->or_else( \&code ) An older form of `else_with_f'; this method passes only the original future itself to the code, not its failure and details. The code would have to call `failure' on the future to obtain the result. $f2 = $code->( $f1 ) This method may be removed in a later version; use `else_with_f' in new code. DEPENDENT 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 or failure. 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. 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. 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. 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 DEPENDENT FUTURES The following methods apply to dependent (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. 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. my $f = Future->new->done( $value ); This is neater handled by the `wrap' class method, which encapsulates its arguments in a new immediate `Future', except if it is given a single argument that is already a `Future': my $f = Future->wrap( $value ); Similarly, the `fail' and `die' methods can be used to generate a `Future' that is immediately failed. my $f = Future->new->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->new->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. 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 AUTHOR Paul Evans Future-0.23/Build.PL000444001750001750 106412266767434 13104 0ustar00leoleo000000000000use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Future', build_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 }, auto_configure_requires => 0, # Don't add M::B to configure_requires license => 'perl', create_makefile_pl => 'traditional', create_license => 1, create_readme => 1, ); $build->create_build_script; Future-0.23/LICENSE000444001750001750 4376012266767434 12646 0ustar00leoleo000000000000This software is copyright (c) 2014 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) 2014 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, Suite 500, Boston, MA 02110-1335 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) 2014 by Paul Evans . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Future-0.23/META.yml000444001750001750 117512266767434 13064 0ustar00leoleo000000000000--- abstract: 'represent an operation awaiting completion' author: - 'Paul Evans ' build_requires: Test::Fatal: 0 Test::Identity: 0 Test::More: 0.88 Test::Refcount: 0 dynamic_config: 1 generated_by: 'Module::Build version 0.4202, CPAN::Meta::Converter version 2.133380' 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.23 Future::Utils: file: lib/Future/Utils.pm version: 0.23 requires: perl: 5.008 resources: license: http://dev.perl.org/licenses/ version: 0.23 Future-0.23/MANIFEST000444001750001750 113412266767434 12737 0ustar00leoleo000000000000Build.PL Changes examples/anyevent.pl examples/io-async.pl examples/poe.pl lib/Future.pm lib/Future/Phrasebook.pod lib/Future/Utils.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/07and_then.t t/08or_else.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/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/99pod.t Future-0.23/Makefile.PL000444001750001750 72312266767434 13543 0ustar00leoleo000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4202 require 5.008; use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Future', 'VERSION_FROM' => 'lib/Future.pm', 'PREREQ_PM' => { 'Test::Fatal' => 0, 'Test::Identity' => 0, 'Test::More' => '0.88', 'Test::Refcount' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Future-0.23/lib000755001750001750 012266767434 12220 5ustar00leoleo000000000000Future-0.23/lib/Future.pm000444001750001750 13541112266767434 14232 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2011-2014 -- leonerd@leonerd.org.uk package Future; use strict; use warnings; no warnings 'recursion'; # Disable the "deep recursion" warning our $VERSION = '0.23'; use Carp qw(); # don't import croak use Scalar::Util qw( weaken blessed ); use B qw( svref_2object ); our @CARP_NOT = qw( Future::Utils ); use constant DEBUG => $ENV{PERL_FUTURE_DEBUG}; =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 sub-tasks, and are implicitly marked as ready depending on the readiness of their component futures as required. These are called "dependent" futures here, and are 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. 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. This feature is enabled by setting an environment variable called C to some true value. $ 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 =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 new { my $proto = shift; return bless { ready => 0, callbacks => [], # [] = [$type, ...] ( DEBUG ? ( constructed_at => join " line ", (caller)[1,2] ) : () ), }, ( ref $proto || $proto ); } my $GLOBAL_END; END { $GLOBAL_END = 1; } *DESTROY = sub { my $self = shift; return if $GLOBAL_END; return if $self->{ready}; 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'. warn "$self was constructed at $self->{constructed_at} and was lost near $lost_at before it was ready.\n"; } if DEBUG; =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. =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->new->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->new->fail( $@ ); blessed $f and $f->isa( "Future" ) or $f = $class->new->fail( "Expected code to return a Future" ); return $f; } sub _mark_ready { my $self = shift; $self->{ready} = 1; 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 ); 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; 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" ) ) { die "Expected " . CvNAME_FILE_LINE($code) . " to return a Future\n"; } $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 ]; } } else { $code->( ( $flags & CB_SELF ? $self : () ), ( $flags & CB_RESULT ? @result : () ), ); } } } sub _state { my $self = shift; return !$self->{ready} ? "pending" : $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 dependent future. Returns the C<$future> to allow easy chaining to create an immediate future by return Future->new->done( ... ) 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. =cut sub done { my $self = shift; $self->{cancelled} and return $self; $self->{ready} and Carp::croak "$self is already ".$self->_state." and cannot be ->done"; $self->{subs} and Carp::croak "$self is not a leaf Future, cannot be ->done"; $self->{result} = [ @_ ]; $self->_mark_ready; 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. The same effect can be achieved using L: $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. Returns the C<$future> to allow easy chaining to create an immediate failed future by return Future->new->fail( ... ) 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. =cut sub fail { my $self = shift; my ( $exception, @details ) = @_; $self->{cancelled} and return $self; $self->{ready} and Carp::croak "$self is already ".$self->_state." and cannot be ->fail'ed"; $self->{subs} and Carp::croak "$self is not a leaf Future, cannot be ->fail'ed"; $_[0] or Carp::croak "$self ->fail requires an exception that is true"; $self->{failure} = [ $exception, @details ]; $self->_mark_ready; 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. The same effect can be achieved using L: $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; $self->{ready} and return $self; push @{ $self->{on_cancel} }, @_; 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 dependent 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 ) = @_; if( $self->{ready} ) { my $is_future = blessed( $code ) && $code->isa( "Future" ); my $fail = defined $self->{failure}; my $done = !$fail && !$self->{cancelled}; $is_future ? ( $done ? $code->done( $self->get ) : $fail ? $code->fail( $self->failure ) : $code->cancel ) : $code->( $self ); } else { push @{ $self->{callbacks} }, [ CB_ALWAYS|CB_SELF, $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 dependent 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} ) { my $exception = $self->{failure}->[0]; !ref $exception && $exception =~ m/\n$/ ? CORE::die $exception : Carp::croak $exception; } $self->{cancelled} and Carp::croak "$self was cancelled"; return $self->{result}->[0] unless wantarray; return @{ $self->{result} }; } =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 ) = @_; if( $self->{ready} ) { return $self if $self->{failure} or $self->{cancelled}; my $is_future = blessed( $code ) && $code->isa( "Future" ); $is_future ? $code->done( $self->get ) : $code->( $self->get ); } else { push @{ $self->{callbacks} }, [ CB_DONE|CB_RESULT, $code ]; } return $self; } =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}; 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 ) = @_; if( $self->{ready} ) { return $self if not $self->{failure}; my $is_future = blessed( $code ) && $code->isa( "Future" ); $is_future ? $code->fail( $self->failure ) : $code->( $self->failure ); } else { push @{ $self->{callbacks} }, [ CB_FAIL|CB_RESULT, $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 dependent 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; 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. The same effect can be achieved using L: $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/^.*:://; 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->new->done( @$code ); } elsif( $flags & CB_SEQ_IMFAIL ) { return Future->new->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->new->fail( $@ ); } unless( blessed $fseq and $fseq->isa( "Future" ) ) { die "Expected " . CvNAME_FILE_LINE($code) . " to return a Future\n"; } return $fseq; } my $fseq = $f1->new; $fseq->on_cancel( $f1 ); push @{ $f1->{callbacks} }, [ CB_DONE|CB_FAIL|$flags, $code, $fseq ]; 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 ); } # 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; return $self->new->done( $xfrm_done->( $self->get ) ); } else { return $self unless $xfrm_fail; return $self->new->fail( $xfrm_fail->( $self->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 ); } =head2 $future = $f1->and_then( \&code ) An older form of C; this method passes only the original future itself to the code, not its result. The code would have to call C on the future to obtain the result. $f2 = $code->( $f1 ) This method may be removed in a later version; use C in new code. =cut sub and_then { my $self = shift; my ( $code ) = @_; return $self->_sequence( $code, CB_SEQ_ONDONE|CB_SELF ); } =head2 $future = $f1->or_else( \&code ) An older form of C; this method passes only the original future itself to the code, not its failure and details. The code would have to call C on the future to obtain the result. $f2 = $code->( $f1 ) This method may be removed in a later version; use C in new code. =cut sub or_else { my $self = shift; my ( $code ) = @_; return $self->_sequence( $code, CB_SEQ_ONFAIL|CB_SELF ); } =head1 DEPENDENT 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_dependent { 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 or failure. 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 = Future->new->done; $self->{subs} = []; return $self; } my $self = Future->_new_dependent( \@subs ); my $pending = 0; $_->{ready} or $pending++ for @subs; # Look for immediate ready if( !$pending ) { $self->{result} = [ @subs ]; $self->_mark_ready; return $self; } weaken( my $weakself = $self ); my $sub_on_ready = sub { return if $_[0]->{cancelled}; return unless $weakself; $pending--; $pending and return; $weakself->{result} = [ @subs ]; $weakself->_mark_ready; }; 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. 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 = Future->new->fail( "Cannot ->wait_any with no subfutures" ); $self->{subs} = []; return $self; } my $self = Future->_new_dependent( \@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; return $self; } weaken( my $weakself = $self ); my $sub_on_ready = sub { return if $_[0]->{cancelled}; return unless $weakself; foreach my $sub ( @subs ) { $sub->{ready} or $sub->cancel; } if( $_[0]->{failure} ) { $weakself->{failure} = [ $_[0]->failure ]; } else { $weakself->{result} = [ $_[0]->get ]; } $weakself->_mark_ready; }; foreach my $sub ( @subs ) { # No need to test $sub->{ready} since we know none of them are $sub->on_ready( $sub_on_ready ); } 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. 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 = Future->new->done; $self->{subs} = []; return $self; } my $self = Future->_new_dependent( \@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; return $self; } my $pending = 0; $_->{ready} or $pending++ for @subs; # Look for immediate done if( !$pending ) { $self->{result} = [ map { $_->get } @subs ]; $self->_mark_ready; return $self; } weaken( my $weakself = $self ); my $sub_on_ready = sub { return if $_[0]->{cancelled}; return unless $weakself; if( my @failure = $_[0]->failure ) { foreach my $sub ( @subs ) { $sub->cancel if !$sub->{ready}; } $weakself->{failure} = \@failure; $weakself->_mark_ready; } else { $pending--; $pending and return; $weakself->{result} = [ map { $_->get } @subs ]; $weakself->_mark_ready; } }; 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. 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 = Future->new->fail( "Cannot ->needs_any with no subfutures" ); $self->{subs} = []; return $self; } my $self = Future->_new_dependent( \@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} or $sub->cancel; } $self->{result} = [ $immediate_done->get ]; $self->_mark_ready; return $self; } # Look for immediate fail my $immediate_fail = 1; foreach my $sub ( @subs ) { $sub->{ready} or $immediate_fail = 0, last; } if( $immediate_fail ) { # For consistency we'll pick the last one for the failure $self->{failure} = [ $subs[-1]->{failure} ]; $self->_mark_ready; return $self; } weaken( my $weakself = $self ); my $sub_on_ready = sub { return if $_[0]->{cancelled}; return unless $weakself; $pending--; if( my @failure = $_[0]->failure ) { $pending and return; $weakself->{failure} = \@failure; $weakself->_mark_ready; } else { foreach my $sub ( @subs ) { $sub->cancel if !$sub->{ready}; } $weakself->{result} = [ $_[0]->get ]; $weakself->_mark_ready; } }; foreach my $sub ( @subs ) { $sub->{ready} or $sub->on_ready( $sub_on_ready ); } return $self; } =head1 METHODS ON DEPENDENT FUTURES The following methods apply to dependent (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-dependent 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-dependent Future"; return grep { $_->{ready} } @{ $self->{subs} }; } sub done_futures { my $self = shift; $self->{subs} or Carp::croak "Cannot call ->done_futures on a non-dependent 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-dependent 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-dependent Future"; return grep { $_->{ready} and $_->{cancelled} } @{ $self->{subs} }; } =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. my $f = Future->new->done( $value ); This is neater handled by the C class method, which encapsulates its arguments in a new immediate C, except if it is given a single argument that is already a C: my $f = Future->wrap( $value ); Similarly, the C and C methods can be used to generate a C that is immediately failed. my $f = Future->new->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->new->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 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 AUTHOR Paul Evans =cut 0x55AA; Future-0.23/lib/Future000755001750001750 012266767434 13472 5ustar00leoleo000000000000Future-0.23/lib/Future/Phrasebook.pod000444001750001750 3374612266767434 16465 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk =head1 NAME C - coding examples for C and C This documentation-only module provides a phrasebook-like approach to giving examples on how to use L and L to structure Future-driven asynchronous or concurrent logic. As with any inter-dialect phrasebook it is structured into pairs of examples; each given first in a traditional call/return Perl style, and second in a style using Futures. In each case, the generic function or functions in the example are named in C to make them stand out. In the examples showing use of Futures, any function that is expected to return a C instance is named with a leading C prefix. Each example is also constructed so as to yield an overall future in a variable called C<$f>, which represents the entire operation. =head1 SEQUENCING The simplest example of a sequencing operation is simply running one piece of code, then immediately running a second. In call/return code we can just place one after the other. FIRST(); SECOND(); Using a Future it is necessary to await the result of the first C before calling the second. my $f = F_FIRST() ->then( sub { F_SECOND(); } ); Here, the anonymous closure is invoked once the C returned by C succeeds. Because C invokes the code block only if the first Future succeeds, it shortcircuits around failures similar to the way that C shortcircuits around thrown exceptions. A C representing the entire combination is returned by the method. Because the C method itself returns a C representing the overall operation, it can itself be further chained. FIRST(); SECOND(); THIRD(); Z<> my $f = F_FIRST() ->then( sub { F_SECOND(); } ) ->then( sub { F_THIRD(); } ); See below for examples of ways to handle exceptions. =head2 Passing Results Often the result of one function can be passed as an argument to another function. OUTER( INNER() ); The result of the first C is passed into the code block given to the C method. my $f = F_INNER() ->then( sub { F_OUTER( @_ ) } ); =head1 CONDITIONALS It may be that the result of one function call is used to determine whether or not another operation is taken. if( COND() == $value ) { ACTION(); } Because the C code block is given the first future in addition to its results it can decide whether to call the second function to return a new future, or simply return the one it was given. my $f = F_COND() ->then_with_f( sub { my ( $f_cond, $result ) = @_; if( $result == $value ) { return F_ACTION(); } else { return $f_cond; } }); =head1 EXCEPTION HANDLING In regular call/return style code, if any function throws an exception, the remainder of the block is not executed, the containing C or C is aborted, and control is passed to the corresponding C or line after the C. try { FIRST(); } catch { my $e = $_; ERROR( $e ); }; The C method on a C can be used here. It behaves similar to C, but is only invoked if the initial C fails; not if it succeeds. my $f = F_FIRST() ->else( sub { F_ERROR( @_ ); } ); Alternatively, the second argument to the C method can be applied, which is invoked only on case of failure. my $f = F_FIRST() ->then( undef, sub { F_ERROR( @_ ); } ); Often it may be the case that the failure-handling code is in fact immediate, and doesn't return a C. In that case, the C code block can return an immediate C instance. my $f = F_FIRST() ->else( sub { ERROR( @_ ); return Future->new->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->new->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 }; 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->new->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 dependent Future returns a concatenated list of the results of all its component Futures, as the only way it will succeed is if all the components do. =head2 Waiting on Multiple Calls of One Function Because the C and C constructors take an entire list of C instances, they can be conveniently used with C to wait on the result of calling a function concurrently once per item in a list. my @RESULT = map { FUNC( $_ ) } @ITEMS; PROCESS( @RESULT ); Again, the C version allows more convenient access to the list of results. my $f = Future->needs_all( map { F_FUNC( $_ ) } @ITEMS ) ->then( sub { my @RESULT = @_; F_PROCESS( @RESULT ) } ); This form of the code starts every item's future concurrently, then waits for all of them. If the list of C<@ITEMS> is potentially large, this may cause a problem due to too many items running at once. Instead, the C family of functions can be used to bound the concurrency, keeping at most some given number of items running, starting new ones as existing ones complete. my $f = fmap { my $item = shift; F_FUNC( $item ) } foreach => \@ITEMS; By itself, this will not actually act concurrently as it will only keep one Future outstanding at a time. The C flag lets it keep a larger number "in flight" at any one time: my $f = fmap { my $item = shift; F_FUNC( $item ) } foreach => \@ITEMS, concurrent => 10; The C and C functions return a Future that will eventually give the collected results of the individual item futures, thus making them similar to perl's C operator. Sometimes, no result is required, and the items are run in a loop simply for some side-effect of the body. foreach my $item ( @ITEMS ) { FUNC( $item ); } To avoid having to collect a potentially-large set of results only to throw them away, the C function variant of the C family yields a Future that completes with no result after all the items are complete. my $f = fmap_void { my $item = shift; F_FIRST( $item ) } foreach => \@ITEMS, concurrent => 10; =head1 AUTHOR Paul Evans =cut Future-0.23/lib/Future/Utils.pm000444001750001750 4562712266767434 15323 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk package Future::Utils; use strict; use warnings; our $VERSION = '0.23'; use Exporter '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 ); =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, otherwise 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. =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. =cut sub _repeat { my ( $code, $return, $trialp, $cond, $sense ) = @_; 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 ); }); return $return; } if( !$cond->( $trial ) ^ $sense ) { # Return result $return ||= $trial->new; $trial->on_done( $return ); $trial->on_fail( $return ); return $return; } # 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; } }; 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{until} and $future = _repeat( $code, $future, \$trial, $args{until}, 1 ); $future->on_cancel( sub { $trial->cancel } ); return $future; } =head2 $future = try_repeat { CODE } ... Currently a simple alias to C. However, 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 *try_repeat = \&repeat; =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"; 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->new->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; Future-0.23/examples000755001750001750 012266767434 13270 5ustar00leoleo000000000000Future-0.23/examples/io-async.pl000444001750001750 32412266767434 15463 0ustar00leoleo000000000000use 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"; Future-0.23/examples/anyevent.pl000444001750001750 67512266767434 15603 0ustar00leoleo000000000000package Future::AnyEvent; use base qw( Future ); use AnyEvent; sub await { my $self = shift; my $cv = AnyEvent->condvar; $self->on_ready( sub { $cv->send } ); $cv->recv; } sub new_delay { my $self = shift->new; $self->{w} = AnyEvent->timer( after => shift, cb => $self->done_cb ); return $self; } package main; my $timer = Future::AnyEvent->new_delay( 3 ); print "Awaiting 3 seconds...\n"; $timer->get; print "Done\n"; Future-0.23/examples/poe.pl000444001750001750 106412266767434 14546 0ustar00leoleo000000000000package Future::POE; use base qw( Future ); use POE; sub await { POE::Kernel::run_one_timeslice; } sub new_delay { my $self = shift->new; my ( $delay ) = @_; POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->delay( done => $delay ) }, done => $self->done_cb, }, ); return $self; } package main; # Quiet the warning that ->run hasn't been called, by calling it now POE::Kernel->run(); my $timer = Future::POE->new_delay( 3 ); print "Awaiting 3 seconds...\n"; $timer->get; print "Done\n"; Future-0.23/t000755001750001750 012266767434 11715 5ustar00leoleo000000000000Future-0.23/t/32utils-repeat.t000444001750001750 721612266767434 15030 0ustar00leoleo000000000000#!/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' ); } # 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' ); } # Non-Future return fails { my $future; $future = repeat { "non-Future" } while => sub { !shift->failure }; is( $future->failure, "Expected code 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->new->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->new->fail( "Too low" ); } else { return Future->new->done( $attempt ); } }; ok( $future->is_ready, '$future is now ready for try_repeat_until_success' ); is( scalar $future->get, 3, '$future->get' ); } done_testing; Future-0.23/t/00use.t000444001750001750 17312266767434 13154 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use_ok( "Future" ); use_ok( "Future::Utils" ); done_testing; Future-0.23/t/34utils-repeat-foreach.t000444001750001750 660112266767434 16434 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Future; use Future::Utils qw( 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->fail( "failure" ); 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->new->done( "ignore me $_[0]" ); } foreach => [qw( one two three )], otherwise => sub { $last_trial_f = shift; return Future->new->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->new->done( "ignore me" ); } foreach => [], otherwise => sub { Future->new->fail( "Nothing to do\n" ) }; is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty list' ); } # foreach while { my $future = repeat { my $arg = shift; if( $arg eq "bad" ) { return Future->new->fail( "bad" ); } else { return Future->new->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 = repeat { my $arg = shift; if( $arg eq "bad" ) { return Future->new->fail( "bad" ); } else { return Future->new->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->new->done( $_[0] ); } foreach => [ 1, 2, 3 ], while => sub { $_[0]->get < 2 }, otherwise => sub { Future->new->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->new->fail( "bad" ); } else { return Future->new->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 = repeat { 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->new->done; } foreach => [], otherwise => sub { die "It failed finally\n" }; is( $future->failure, "It failed finally\n", 'repeat foreach failure after otherwise exception' ); } done_testing; Future-0.23/t/07and_then.t000444001750001750 400712266767434 14167 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Test::Identity; use Future; { my $f1 = Future->new; my $f2; my $fseq = $f1->and_then( sub { identical( $_[0], $f1, 'and_then block passed $f1' ); return $f2 = Future->new; } ); ok( defined $fseq, '$fseq defined' ); isa_ok( $fseq, "Future", '$fseq' ); $f1->done; $f2->done( results => "here" ); is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); } # code dies { my $f1 = Future->new; my $fseq = $f1->and_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->new->done; my $called = 0; my $fseq = $f1->and_then( sub { $called++; return $_[0] } ); is( $called, 1, 'and_then block invoked immediately for already-done' ); ok( $fseq->is_ready, '$fseq already ready for already-done' ); } # immediately fail { my $f1 = Future->new->fail("Failure\n"); my $called = 0; my $fseq = $f1->and_then( sub { $called++; return $_[0] } ); is( $called, 0, 'and_then block not invoked for already-failed' ); ok( $fseq->is_ready, '$fseq already ready for already-failed' ); } # Void context raises a warning { my $warnings; local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; Future->new->done->and_then( sub { Future->new } ); like( $warnings, qr/^Calling ->and_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->and_then( sub {} ); like( exception { $f1->done }, qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, 'Exception from non-Future return' ); } done_testing; Future-0.23/t/06followed_by.t000444001750001750 1024212266767434 14731 0ustar00leoleo000000000000#!/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' ); # Two refs; one in lexical $fseq, one via $f1 is_refcount( $fseq, 2, '$fseq has refcount 2 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' ); # Two refs; one in lexical $fseq, one via $f1 is_refcount( $fseq, 2, '$fseq has refcount 2 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->new->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->new->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->new->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->new->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->new->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 {} ); like( exception { $f1->done }, qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, 'Exception from non-Future return' ); } done_testing; Future-0.23/t/01future.t000444001750001750 2027412266767434 13737 0ustar00leoleo000000000000#!/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' ); 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->new; $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' ); 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->new; $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->new->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' ); is( $future->failure, "Expected code to return a Future", '$future->failure from non-future returning Future->call' ); } done_testing; Future-0.23/t/09transform.t000444001750001750 244612266767434 14431 0ustar00leoleo000000000000#!/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->new->done->transform( done => sub { } ); like( $warnings, qr/^Calling ->transform in void context at /, 'Warning in void context' ); } done_testing; Future-0.23/t/11wait_any.t000444001750001750 602312266767434 14215 0ustar00leoleo000000000000#!/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->new->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' ); } # 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; Future-0.23/t/35utils-map-void.t000444001750001750 1171612266767434 15307 0ustar00leoleo000000000000#!/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->new->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->new->done, Future->new->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->new->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->new->done; } foreach => [ 0 ], return => my $ret = Future->new; identical( $future, $ret, 'repeat with return yields correct instance' ); } done_testing; Future-0.23/t/12needs_all.t000444001750001750 642612266767434 14340 0ustar00leoleo000000000000#!/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->new->done ); ok( $future->is_ready, '$future of already-done sub already ready' ); } # immediately fails { my $future = Future->needs_all( Future->new->fail("F1"), Future->new->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' ); } # 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; Future-0.23/t/04else.t000444001750001750 1345612266767434 13364 0ustar00leoleo000000000000#!/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' ); # Two refs; one in lexical $fseq, one via $f1 is_refcount( $fseq, 2, '$fseq has refcount 2 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_refcount( $fseq, 2, '$fseq has refcount 2 initially' ); ok( !$f2, '$f2 not yet defined before $f1 fails' ); $f1->fail( "f1 failure\n" ); undef $f1; is_refcount( $fseq, 2, '$fseq has refcount 2 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->new->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->new->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->new->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 {} ); like( exception { $f1->fail( "failed\n" ) }, qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, 'Exception from non-Future return' ); } # 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; Future-0.23/t/20subclass.t000444001750001750 463312266767434 14226 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; # subclass->... { my $f = t::Future::Subclass->new; isa_ok( $f->then( sub {} ), "t::Future::Subclass", '$f->then' ); isa_ok( $f->else( sub {} ), "t::Future::Subclass", '$f->and_then' ); isa_ok( $f->then_with_f( sub {} ), "t::Future::Subclass", '$f->then_with_f' ); isa_ok( $f->else_with_f( sub {} ), "t::Future::Subclass", '$f->else_with_f' ); isa_ok( $f->followed_by( sub {} ), "t::Future::Subclass", '$f->followed_by' ); isa_ok( $f->and_then( sub {} ), "t::Future::Subclass", '$f->and_then' ); isa_ok( $f->or_else( sub {} ), "t::Future::Subclass", '$f->or_else' ); isa_ok( $f->transform(), "t::Future::Subclass", '$f->transform' ); } # immediate->followed_by( sub { subclass } ) { my $f = t::Future::Subclass->new; isa_ok( Future->new->done->followed_by( sub { $f } ), "t::Future::Subclass", 'imm->followed_by $f' ); } # dependents { my $f = t::Future::Subclass->new; isa_ok( Future->wait_all( $f ), "t::Future::Subclass", 'Future->wait_all( $f )' ); isa_ok( Future->wait_any( $f ), "t::Future::Subclass", 'Future->wait_any( $f )' ); isa_ok( Future->needs_all( $f ), "t::Future::Subclass", 'Future->needs_all( $f )' ); isa_ok( Future->needs_any( $f ), "t::Future::Subclass", 'Future->needs_any( $f )' ); my $imm = Future->new->done; isa_ok( 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( Future->wait_all( Future->new, $f ), "t::Future::Subclass", 'Future->wait_all( Future->new, $f' ); } 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->( @_ ); } Future-0.23/t/36utils-map.t000444001750001750 306212266767434 14324 0ustar00leoleo000000000000#!/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; Future-0.23/t/10wait_all.t000444001750001750 731512266767434 14202 0ustar00leoleo000000000000#!/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->new->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->new->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' ); } # 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; Future-0.23/t/33utils-repeat-generate.t000444001750001750 312312266767434 16612 0ustar00leoleo000000000000#!/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->fail( "failure" ); 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->new->done( "ignore me $_[0]" ); } generate => sub { $i < 3 ? ++$i : () }, otherwise => sub { $last_trial_f = shift; return Future->new->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->new->done( "ignore me" ); } generate => sub { () }, otherwise => sub { Future->new->fail( "Nothing to do\n" ) }; is( scalar $future->failure, "Nothing to do\n", '$future returns otherwise failure for empty generator' ); } # Probably don't need much more testing since most combinations are test with # foreach - while/until, die, etc.. done_testing; Future-0.23/t/05then-else.t000444001750001750 323412266767434 14272 0ustar00leoleo000000000000#!/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; Future-0.23/t/03then.t000444001750001750 1414012266767434 13360 0ustar00leoleo000000000000#!/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' ); # Two refs; one in lexical $fseq, one via $f1 is_refcount( $fseq, 2, '$fseq has refcount 2 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_refcount( $fseq, 2, '$fseq has refcount 2 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->new->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->new->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' ); } # Void context raises a warning { my $warnings; local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; Future->new->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 {} ); like( exception { $f1->done }, qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, 'Exception from non-Future return' ); } # 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; Future-0.23/t/02cancel.t000444001750001750 612012266767434 13625 0ustar00leoleo000000000000#!/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' ); } # 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' ); } # 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' ); } done_testing; Future-0.23/t/21debug.t000444001750001750 143512266767434 13473 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 3; BEGIN { $ENV{PERL_FUTURE_DEBUG} = 1; } use Future; 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 before it was ready\.$/, 'Lost Future raises a warning' ); Future-0.23/t/99pod.t000444001750001750 25712266767434 13167 0ustar00leoleo000000000000#!/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(); Future-0.23/t/13needs_any.t000444001750001750 1025312266767434 14371 0ustar00leoleo000000000000#!/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->new->fail("F1"), Future->new->done ); ok( $future->is_ready, '$future of already-done sub already ready' ); } # immediately fails { my $future = Future->needs_any( Future->new->fail("F1") ); 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->fail( "booo" ); $future->cancel; is( $c1, 1, '$future->cancel marks subs cancelled' ); is( $c2, undef, '$future->cancel ignores ready subs' ); } # 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; Future-0.23/t/30utils-call.t000444001750001750 153412266767434 14456 0ustar00leoleo000000000000#!/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' ); } # 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' ); is( scalar $f->failure, "Expected code to return a Future", 'failure from immediate future on non-future return' ); } done_testing; Future-0.23/t/08or_else.t000444001750001750 415012266767434 14037 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Test::Identity; use Future; # First failure { my $f1 = Future->new; my $f2; my $fseq = $f1->or_else( sub { identical( $_[0], $f1, 'or_else block passed $f1' ); return $f2 = Future->new; } ); ok( defined $fseq, '$fseq defined' ); isa_ok( $fseq, "Future", '$fseq' ); $f1->fail( "Broken\n" ); $f2->done( results => "here" ); ok( $fseq->is_ready, '$fseq is done after $f2 done' ); is_deeply( [ $fseq->get ], [ results => "here" ], '$fseq->get returns results' ); } # code dies { my $f1 = Future->new; my $fseq = $f1->or_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' ); } # immediately fail { my $f1 = Future->new->fail("Failure\n"); my $called = 0; my $fseq = $f1->or_else( sub { $called++; return $_[0] } ); is( $called, 1, 'or_else block invoked immediately for already-fail' ); ok( $fseq->is_ready, '$fseq already ready for already-fail' ); } # immediately done { my $f1 = Future->new->done("Result"); my $called = 0; my $fseq = $f1->or_else( sub { $called++; return $_[0] } ); is( $called, 0, 'or_else block not invoked for already-done' ); ok( $fseq->is_ready, '$fseq already ready for already-done' ); } # Void context raises a warning { my $warnings; local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; Future->new->done->or_else( sub { Future->new } ); like( $warnings, qr/^Calling ->or_else 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->or_else( sub {} ); like( exception { $f1->fail(1) }, qr/^Expected __ANON__\(\Q$file\E line $line\) to return a Future/, 'Exception from non-Future return' ); } done_testing; Future-0.23/t/31utils-call-with-escape.t000444001750001750 312112266767434 16660 0ustar00leoleo000000000000#!/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;