Hello community, here is the log from the commit of package perl-Future for openSUSE:Factory checked in at 2018-02-09 15:47:35 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Future (Old) and /work/SRC/openSUSE:Factory/.perl-Future.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Future" Fri Feb 9 15:47:35 2018 rev:6 rq:573989 version:0.38 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Future/perl-Future.changes 2017-12-08 13:01:47.736134241 +0100 +++ /work/SRC/openSUSE:Factory/.perl-Future.new/perl-Future.changes 2018-02-09 15:47:38.315191794 +0100 @@ -1,0 +2,13 @@ +Wed Feb 7 16:32:52 UTC 2018 - [email protected] + +- updated to 0.38 + see /usr/share/doc/packages/perl-Future/Changes + + 0.38 2017-12-18 01:41:52 + [CHANGES] + * Added counting ability to Future::Mutex (RT123876) + + [BUGFIXES] + * Support perl 5.8.1 again (thanks ilmari) + +------------------------------------------------------------------- Old: ---- Future-0.37.tar.gz New: ---- Future-0.38.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Future.spec ++++++ --- /var/tmp/diff_new_pack.ittctq/_old 2018-02-09 15:47:39.207159763 +0100 +++ /var/tmp/diff_new_pack.ittctq/_new 2018-02-09 15:47:39.211159620 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-Future # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,7 +17,7 @@ Name: perl-Future -Version: 0.37 +Version: 0.38 Release: 0 %define cpan_name Future Summary: Represent an Operation Awaiting Completion ++++++ Future-0.37.tar.gz -> Future-0.38.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/Changes new/Future-0.38/Changes --- old/Future-0.37/Changes 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/Changes 2017-12-18 02:44:55.000000000 +0100 @@ -1,5 +1,12 @@ Revision history for Future +0.38 2017-12-18 01:41:52 + [CHANGES] + * Added counting ability to Future::Mutex (RT123876) + + [BUGFIXES] + * Support perl 5.8.1 again (thanks ilmari) + 0.37 2017/11/28 15:39:22 [CHANGES] * Finally got around to removing the old Makefile.PL diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/META.json new/Future-0.38/META.json --- old/Future-0.37/META.json 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/META.json 2017-12-18 02:44:55.000000000 +0100 @@ -39,19 +39,19 @@ "provides" : { "Future" : { "file" : "lib/Future.pm", - "version" : "0.37" + "version" : "0.38" }, "Future::Mutex" : { "file" : "lib/Future/Mutex.pm", - "version" : "0.37" + "version" : "0.38" }, "Future::Utils" : { "file" : "lib/Future/Utils.pm", - "version" : "0.37" + "version" : "0.38" }, "Test::Future" : { "file" : "lib/Test/Future.pm", - "version" : "0.37" + "version" : "0.38" } }, "release_status" : "stable", @@ -61,6 +61,6 @@ ], "x_IRC" : "irc://irc.perl.org/#io-async" }, - "version" : "0.37", + "version" : "0.38", "x_serialization_backend" : "JSON::PP version 2.94" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/META.yml new/Future-0.38/META.yml --- old/Future-0.37/META.yml 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/META.yml 2017-12-18 02:44:55.000000000 +0100 @@ -19,16 +19,16 @@ provides: Future: file: lib/Future.pm - version: '0.37' + version: '0.38' Future::Mutex: file: lib/Future/Mutex.pm - version: '0.37' + version: '0.38' Future::Utils: file: lib/Future/Utils.pm - version: '0.37' + version: '0.38' Test::Future: file: lib/Test/Future.pm - version: '0.37' + version: '0.38' requires: Carp: '1.25' Test::Builder::Module: '0' @@ -37,5 +37,5 @@ resources: IRC: irc://irc.perl.org/#io-async license: http://dev.perl.org/licenses/ -version: '0.37' +version: '0.38' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/lib/Future/Mutex.pm new/Future-0.38/lib/Future/Mutex.pm --- old/Future-0.37/lib/Future/Mutex.pm 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/lib/Future/Mutex.pm 2017-12-18 02:44:55.000000000 +0100 @@ -1,14 +1,14 @@ # You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # -# (C) Paul Evans, 2016 -- [email protected] +# (C) Paul Evans, 2016-2017 -- [email protected] package Future::Mutex; use strict; use warnings; -our $VERSION = '0.37'; +our $VERSION = '0.38'; use Future; @@ -51,6 +51,13 @@ (by its returned future providing a result or failing), the next queued code is invoked. +An instance may also be a counting mutex if initialised with a count greater +than one. In this case, it can keep multiple blocks outstanding up to that +limit, with subsequent requests queued as before. This allows it to act as a +concurrency-bounding limit around some operation that can run concurrently, +but an application wishes to apply overall limits to stop it growing too much, +such as communications with external services or executing other programs. + =cut =head1 CONSTRUCTOR @@ -59,18 +66,31 @@ =head2 new - $mutex = Future::Mutex->new + $mutex = Future::Mutex->new( count => $n ) Returns a new C<Future::Mutex> instance. It is initially unlocked. +Takes the following named arguments: + +=over 8 + +=item count => INT + +Optional number to limit outstanding concurrency. Will default to 1 if not +supplied. + +=back + =cut sub new { my $class = shift; + my %params = @_; return bless { - f => Future->done, + avail => $params{count} // 1, + queue => [], }, $class; } @@ -98,13 +118,39 @@ my $self = shift; my ( $code ) = @_; - my $old_f = $self->{f}; - $self->{f} = my $new_f = Future->new; + my $down_f; + if( $self->{avail} ) { + $self->{avail}--; + $down_f = Future->done; + } + else { + push @{ $self->{queue} }, $down_f = Future->new; + } + + my $up = sub { + if( my $next_f = shift @{ $self->{queue} } ) { + $next_f->done; + } + else { + $self->{avail}++; + } + }; + + $down_f->then( $code )->on_ready( $up ); +} - $old_f->then( $code ) - ->then_with_f( - ( sub { my $f = shift; $new_f->done; $f; } ) x 2 - ); +=head2 available + + $avail = $mutex->available + +Returns true if the mutex is currently unlocked, or false if it is locked. + +=cut + +sub available +{ + my $self = shift; + return $self->{avail}; } =head1 AUTHOR diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/lib/Future/Utils.pm new/Future-0.38/lib/Future/Utils.pm --- old/Future-0.37/lib/Future/Utils.pm 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/lib/Future/Utils.pm 2017-12-18 02:44:55.000000000 +0100 @@ -8,7 +8,7 @@ use strict; use warnings; -our $VERSION = '0.37'; +our $VERSION = '0.38'; use Exporter 'import'; # Can't import the one from Exporter as it relies on package inheritance diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/lib/Future.pm new/Future-0.38/lib/Future.pm --- old/Future-0.37/lib/Future.pm 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/lib/Future.pm 2017-12-18 02:44:55.000000000 +0100 @@ -9,7 +9,7 @@ use warnings; no warnings 'recursion'; # Disable the "deep recursion" warning -our $VERSION = '0.37'; +our $VERSION = '0.38'; use Carp qw(); # don't import croak use Scalar::Util qw( weaken blessed reftype ); @@ -21,7 +21,7 @@ our @CARP_NOT = qw( Future::Utils ); -use constant DEBUG => $ENV{PERL_FUTURE_DEBUG}; +use constant DEBUG => !!$ENV{PERL_FUTURE_DEBUG}; our $TIMES = DEBUG || $ENV{PERL_FUTURE_TIMES}; @@ -237,8 +237,9 @@ # 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"; + $cop = $cop->next while $cop and ref $cop ne "B::COP" and ref $cop ne "B::NULL"; + return $cv->GV->NAME if ref $cop eq "B::NULL"; sprintf "%s(%s line %d)", $cv->GV->NAME, $cop->file, $cop->line; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/lib/Test/Future.pm new/Future-0.38/lib/Test/Future.pm --- old/Future-0.37/lib/Test/Future.pm 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/lib/Test/Future.pm 2017-12-18 02:44:55.000000000 +0100 @@ -9,7 +9,7 @@ use warnings; use base qw( Test::Builder::Module ); -our $VERSION = '0.37'; +our $VERSION = '0.38'; our @EXPORT = qw( no_pending_futures diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/t/02cancel.t new/Future-0.38/t/02cancel.t --- old/Future-0.37/t/02cancel.t 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/t/02cancel.t 2017-12-18 02:44:55.000000000 +0100 @@ -45,7 +45,8 @@ like( exception { $future->get }, qr/cancelled/, '$future->get throws exception by cancel' ); - ok( !exception { $future->cancel }, '$future->cancel a second time is OK' ); + is( exception { $future->cancel }, undef, + '$future->cancel a second time is OK' ); $done_f->cancel; $fail_f->cancel; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/t/03then.t new/Future-0.38/t/03then.t --- old/Future-0.37/t/03then.t 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/t/03then.t 2017-12-18 02:44:55.000000000 +0100 @@ -195,10 +195,10 @@ my $file = __FILE__; my $line = __LINE__+1; - my $fseq = $f1->then( sub {} ); + my $fseq = $f1->then( sub { undef } ); my $fseq2 = $f1->then( sub { Future->done } ); - ok( !exception { $f1->done }, + is( exception { $f1->done }, undef, '->done with non-Future return from ->then does not die' ); like( $fseq->failure, @@ -208,7 +208,7 @@ ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); my $fseq3; - ok( !exception { $fseq3 = $f1->then( sub {} ) }, + is( exception { $fseq3 = $f1->then( sub { undef } ) }, undef, 'non-Future return from ->then on immediate does not die' ); like( $fseq3->failure, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/t/04else.t new/Future-0.38/t/04else.t --- old/Future-0.37/t/04else.t 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/t/04else.t 2017-12-18 02:44:55.000000000 +0100 @@ -164,10 +164,10 @@ my $file = __FILE__; my $line = __LINE__+1; - my $fseq = $f1->else( sub {} ); + my $fseq = $f1->else( sub { undef } ); my $fseq2 = $f1->else( sub { Future->done } ); - ok( !exception { $f1->fail( "failed\n" ) }, + is( exception { $f1->fail( "failed\n" ) }, undef, '->fail with non-Future return from ->else does not die' ); like( $fseq->failure, @@ -177,7 +177,7 @@ ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); my $fseq3; - ok( !exception { $fseq3 = $f1->else( sub {} ) }, + is( exception { $fseq3 = $f1->else( sub { undef } ) }, undef, 'non-Future return from ->else on immediate does not die' ); like( $fseq3->failure, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/t/06followed_by.t new/Future-0.38/t/06followed_by.t --- old/Future-0.37/t/06followed_by.t 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/t/06followed_by.t 2017-12-18 02:44:55.000000000 +0100 @@ -173,10 +173,10 @@ my $file = __FILE__; my $line = __LINE__+1; - my $fseq = $f1->followed_by( sub {} ); + my $fseq = $f1->followed_by( sub { undef } ); my $fseq2 = $f1->followed_by( sub { Future->done } ); - ok( !exception { $f1->done }, + is( exception { $f1->done }, undef, '->done with non-Future return from ->followed_by does not die' ); like( $fseq->failure, @@ -186,7 +186,7 @@ ok( $fseq2->is_ready, '$fseq2 is ready after failure of $fseq' ); my $fseq3; - ok( !exception { $fseq3 = $f1->followed_by( sub {} ) }, + is( exception { $fseq3 = $f1->followed_by( sub { undef } ) }, undef, 'non-Future return from ->followed_by on immediate does not die' ); like( $fseq3->failure, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/t/36utils-map.t new/Future-0.38/t/36utils-map.t --- old/Future-0.37/t/36utils-map.t 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/t/36utils-map.t 2017-12-18 02:44:55.000000000 +0100 @@ -66,9 +66,8 @@ foreach => [ $f ], concurrent => 2; - ok( !exception { - $fmap->cancel; - }, '$fmap_concat->cancel does not throw on undef slots' ); + is( exception { $fmap->cancel }, undef, + '$fmap_concat->cancel does not throw on undef slots' ); ok( $fmap->is_cancelled, 'was cancelled correctly' ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Future-0.37/t/40mutex.t new/Future-0.38/t/40mutex.t --- old/Future-0.37/t/40mutex.t 2017-11-28 16:41:25.000000000 +0100 +++ new/Future-0.38/t/40mutex.t 2017-12-18 02:44:55.000000000 +0100 @@ -12,16 +12,21 @@ { my $mutex = Future::Mutex->new; + ok( $mutex->available, 'Mutex is available' ); + my $f; my $lf = $mutex->enter( sub { $f = Future->new } ); ok( defined $lf, '->enter returns Future' ); ok( defined $f, '->enter on new Mutex runs code' ); + ok( !$mutex->available, 'Mutex is unavailable' ); + ok( !$lf->is_ready, 'locked future not yet ready' ); $f->done; ok( $lf->is_ready, 'locked future ready after $f->done' ); + ok( $mutex->available, 'Mutex is available again' ); } # done chaining @@ -41,6 +46,7 @@ $f2->done; ok( $lf2->is_ready, 'second locked future ready after $f2->done' ); + ok( $mutex->available, 'Mutex is available again' ); } # fail chaining @@ -61,6 +67,7 @@ $f2->done; ok( $lf2->is_ready, 'second locked future ready after $f2->done' ); + ok( $mutex->available, 'Mutex is available again' ); } # immediately done @@ -70,6 +77,8 @@ is( $mutex->enter( sub { Future->done( "result" ) } )->get, "result", '$mutex->enter returns immediate result' ); + + ok( $mutex->available, 'Mutex is available again' ); } # immediately fail @@ -79,6 +88,8 @@ is( $mutex->enter( sub { Future->fail( "oops" ) } )->failure, "oops", '$mutex->enter returns immediate failure' ); + + ok( $mutex->available, 'Mutex is available again' ); } # code dies @@ -89,9 +100,66 @@ "oopsie\n", '$mutex->enter returns immediate failure on exception' ); - is( $mutex->enter( sub { Future->done( "unlocked" ) } )->get, - "unlocked", - '$mutex remains unlocked after exception' ); + ok( $mutex->available, 'Mutex is available again' ); +} + +# cancellation +{ + my $mutex = Future::Mutex->new; + + my $f = $mutex->enter( sub { Future->new } ); + $f->cancel; + + ok( $mutex->available, 'Mutex is available after cancel' ); +} + +# queueing +{ + my $mutex = Future::Mutex->new; + + my ( $f1, $f2, $f3 ); + my $f = Future->needs_all( + $mutex->enter( sub { $f1 = Future->new } ), + $mutex->enter( sub { $f2 = Future->new } ), + $mutex->enter( sub { $f3 = Future->new } ), + ); + + ok( defined $f1, '$f1 defined' ); + $f1->done; + + ok( defined $f2, '$f2 defined' ); + $f2->done; + + ok( defined $f3, '$f3 defined' ); + $f3->done; + + ok( $f->is_done, 'Chain is done' ); + ok( $mutex->available, 'Mutex is available after chain done' ); +} + +# counting +{ + my $mutex = Future::Mutex->new( count => 2 ); + + is( $mutex->available, 2, 'Mutex has 2 counts available' ); + + my ( $f1, $f2, $f3 ); + my $f = Future->needs_all( + $mutex->enter( sub { $f1 = Future->new } ), + $mutex->enter( sub { $f2 = Future->new } ), + $mutex->enter( sub { $f3 = Future->new } ), + ); + + ok( defined $f1 && defined $f2, '$f1 and $f2 defined with count 2' ); + + $f1->done; + ok( defined $f3, '$f3 defined after $f1 done' ); + + $f2->done; + $f3->done; + + ok( $f->is_done, 'Chain is done' ); + ok( $mutex->available, 'Mutex is available after chain done' ); } done_testing;
