This queue is for tickets about the future CPAN distribution.

Report information
The Basics
Id:
133563
Status:
resolved
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
leonerd-cpan [...] leonerd.org.uk
Cc:
AdminCc:

BugTracker
Severity:
(no value)
Broken in:
0.45
Fixed in:
0.46



Subject: Future::Mutex doesn't respect subclassing
If the mutex is already busy, the returned value is a plain Future, not of the required subclass to await (from the previous wait attempt): $ perl use Future::Mutex; use Future::IO; my $m = Future::Mutex->new; print STDERR $m->enter( sub { Future::IO->sleep(1) } ), "\n"; print STDERR $m->enter( sub { Future::IO->sleep(1) } ), "\n"; __END__ Future::IO::_DefaultImpl=HASH(0x55b3792b3038) Future=HASH(0x55b3792b3350) Expected Future::IO::_DefaultImpl on both lines. -- Paul Evans
A relatively easy fix. Patch attached. -- Paul Evans
Subject: rt133563.patch
=== modified file 'lib/Future/Mutex.pm' --- old/lib/Future/Mutex.pm 2020-04-22 14:03:48 +0000 +++ new/lib/Future/Mutex.pm 2020-10-19 16:14:50 +0000 @@ -13,6 +13,8 @@ use Future; +use Scalar::Util qw( weaken ); + =head1 NAME C<Future::Mutex> - mutual exclusion lock around code that returns L<Future>s @@ -91,6 +93,7 @@ return bless { avail => $params{count} // 1, + waitf => undef, queue => [], }, $class; } @@ -125,7 +128,8 @@ $down_f = Future->done; } else { - push @{ $self->{queue} }, $down_f = Future->new; + die "ARGH Need to clone an existing future\n" unless defined $self->{waitf}; + push @{ $self->{queue} }, $down_f = $self->{waitf}->new; } my $up = sub { @@ -134,10 +138,13 @@ } else { $self->{avail}++; + undef $self->{waitf}; } }; - $down_f->then( $code )->on_ready( $up ); + my $retf = $down_f->then( $code )->on_ready( $up ); + $self->{waitf} or weaken( $self->{waitf} = $retf ); + return $retf; } =head2 available === modified file 't/40mutex.t' --- old/t/40mutex.t 2020-03-25 00:08:20 +0000 +++ new/t/40mutex.t 2020-10-19 16:14:50 +0000 @@ -4,6 +4,7 @@ use warnings; use Test::More; +use Test::Refcount; use Future; use Future::Mutex; @@ -15,11 +16,13 @@ ok( $mutex->available, 'Mutex is available' ); my $f; - my $lf = $mutex->enter( sub { $f = Future->new } ); + my $lf = $mutex->enter( sub { $f = t::Future::Subclass->new } ); ok( defined $lf, '->enter returns Future' ); ok( defined $f, '->enter on new Mutex runs code' ); + isa_ok( $lf, "t::Future::Subclass", '$lf' ); + ok( !$mutex->available, 'Mutex is unavailable' ); ok( !$lf->is_ready, 'locked future not yet ready' ); @@ -27,6 +30,9 @@ $f->done; ok( $lf->is_ready, 'locked future ready after $f->done' ); ok( $mutex->available, 'Mutex is available again' ); + + undef $f; + is_oneref( $lf, '$lf has one ref at EOT' ); } # done chaining @@ -34,10 +40,15 @@ my $mutex = Future::Mutex->new; my $f1; - my $lf1 = $mutex->enter( sub { $f1 = Future->new } ); + my $lf1 = $mutex->enter( sub { $f1 = t::Future::Subclass->new } ); my $f2; - my $lf2 = $mutex->enter( sub { $f2 = Future->new } ); + my $lf2 = $mutex->enter( sub { $f2 = t::Future::Subclass->new } ); + + isa_ok( $lf1, "t::Future::Subclass", '$lf1' ); + isa_ok( $lf2, "t::Future::Subclass", '$lf2' ); + + is_oneref( $lf2, '$lf2 has one ref' ); ok( !defined $f2, 'second enter not invoked while locked' ); @@ -47,6 +58,12 @@ $f2->done; ok( $lf2->is_ready, 'second locked future ready after $f2->done' ); ok( $mutex->available, 'Mutex is available again' ); + + undef $f1; + undef $f2; + + is_oneref( $lf1, '$lf1 has one ref at EOT' ); + is_oneref( $lf2, '$lf2 has one ref at EOT' ); } # fail chaining @@ -119,11 +136,13 @@ 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 } ), + $mutex->enter( sub { $f1 = t::Future::Subclass->new } ), + $mutex->enter( sub { $f2 = t::Future::Subclass->new } ), + $mutex->enter( sub { $f3 = t::Future::Subclass->new } ), ); + isa_ok( $f, "t::Future::Subclass", '$f' ); + ok( defined $f1, '$f1 defined' ); $f1->done; @@ -163,3 +182,6 @@ } done_testing; + +package t::Future::Subclass; +use base qw( Future );
Fixed in 0.46. -- Paul Evans


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.