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 - co...@suse.com
+
+- 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 -- leon...@leonerd.org.uk
+#  (C) Paul Evans, 2016-2017 -- leon...@leonerd.org.uk
 
 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;


Reply via email to