r62560 - in /trunk/libtest-sharedfork-perl: ./ debian/ lib/Test/ lib/Test/SharedFork/ t/ t/store/ xt/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Tue Sep 14 17:27:09 UTC 2010
Author: periapt-guest
Date: Tue Sep 14 17:26:56 2010
New Revision: 62560
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62560
Log:
* New upstream release
* Added myself to Uploaders
Added:
trunk/libtest-sharedfork-perl/t/08_threads.t
- copied unchanged from r62559, branches/upstream/libtest-sharedfork-perl/current/t/08_threads.t
trunk/libtest-sharedfork-perl/t/09_very_simple.t
- copied unchanged from r62559, branches/upstream/libtest-sharedfork-perl/current/t/09_very_simple.t
Modified:
trunk/libtest-sharedfork-perl/Changes
trunk/libtest-sharedfork-perl/MANIFEST
trunk/libtest-sharedfork-perl/META.yml
trunk/libtest-sharedfork-perl/README.mkdn
trunk/libtest-sharedfork-perl/debian/changelog
trunk/libtest-sharedfork-perl/debian/control
trunk/libtest-sharedfork-perl/lib/Test/SharedFork.pm
trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Array.pm
trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Scalar.pm
trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Store.pm
trunk/libtest-sharedfork-perl/t/store/01_tie_scalar.t
trunk/libtest-sharedfork-perl/t/store/02_tie_array.t
trunk/libtest-sharedfork-perl/xt/01_podspell.t
Modified: trunk/libtest-sharedfork-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/Changes?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/Changes (original)
+++ trunk/libtest-sharedfork-perl/Changes Tue Sep 14 17:26:56 2010
@@ -1,4 +1,17 @@
Revision history for Perl extension Test::SharedFork
+
+0.15
+
+ - added "LIMITATION" section to docs.
+ I gave up to support ithreads.
+
+0.14
+
+ - release!
+
+0.13_01
+
+ - Test::Builder2 support
0.12
Modified: trunk/libtest-sharedfork-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/MANIFEST?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/MANIFEST (original)
+++ trunk/libtest-sharedfork-perl/MANIFEST Tue Sep 14 17:26:56 2010
@@ -29,6 +29,8 @@
t/05_nest.t
t/06_fail_lineno.t
t/07_lazy_load.t
+t/08_threads.t
+t/09_very_simple.t
t/store/00_simple.t
t/store/01_tie_scalar.t
t/store/02_tie_array.t
Modified: trunk/libtest-sharedfork-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/META.yml?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/META.yml (original)
+++ trunk/libtest-sharedfork-perl/META.yml Tue Sep 14 17:26:56 2010
@@ -23,4 +23,4 @@
perl: 5.8.0
resources:
license: http://dev.perl.org/licenses/
-version: 0.12
+version: 0.15
Modified: trunk/libtest-sharedfork-perl/README.mkdn
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/README.mkdn?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/README.mkdn (original)
+++ trunk/libtest-sharedfork-perl/README.mkdn Tue Sep 14 17:26:56 2010
@@ -26,6 +26,10 @@
This module merges test count with parent process & child process.
+# LIMITATIONS
+
+This version of the Test::SharedFork does not support ithreads, because [threads::shared](http://search.cpan.org/perldoc?threads::shared) conflicts with [Storable](http://search.cpan.org/perldoc?Storable).
+
# AUTHOR
Tokuhiro Matsuno <tokuhirom slkjfd gmail.com>
Modified: trunk/libtest-sharedfork-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/debian/changelog?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/debian/changelog (original)
+++ trunk/libtest-sharedfork-perl/debian/changelog Tue Sep 14 17:26:56 2010
@@ -1,3 +1,10 @@
+libtest-sharedfork-perl (0.15-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Added myself to Uploaders
+
+ -- Nicholas Bamber <nicholas at periapt.co.uk> Tue, 14 Sep 2010 18:24:46 +0100
+
libtest-sharedfork-perl (0.12-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libtest-sharedfork-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/debian/control?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/debian/control (original)
+++ trunk/libtest-sharedfork-perl/debian/control Tue Sep 14 17:26:56 2010
@@ -4,7 +4,8 @@
Build-Depends: debhelper (>= 7)
Build-Depends-Indep: perl, perl (>= 5.10.1) | libtest-simple-perl (>= 0.88)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Jonathan Yu <jawnsy at cpan.org>, gregor herrmann <gregoa at debian.org>
+Uploaders: Jonathan Yu <jawnsy at cpan.org>, gregor herrmann <gregoa at debian.org>,
+Nicholas Bamber <nicholas at periapt..co.uk>
Standards-Version: 3.9.1
Homepage: http://search.cpan.org/dist/Test-SharedFork/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libtest-sharedfork-perl/
Modified: trunk/libtest-sharedfork-perl/lib/Test/SharedFork.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/lib/Test/SharedFork.pm?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/lib/Test/SharedFork.pm (original)
+++ trunk/libtest-sharedfork-perl/lib/Test/SharedFork.pm Tue Sep 14 17:26:56 2010
@@ -2,37 +2,119 @@
use strict;
use warnings;
use base 'Test::Builder::Module';
-our $VERSION = '0.12';
+our $VERSION = '0.15';
use Test::Builder 0.32; # 0.32 or later is needed
use Test::SharedFork::Scalar;
use Test::SharedFork::Array;
use Test::SharedFork::Store;
+use Config;
use 5.008000;
+
+{
+ package #
+ Test::SharedFork::Contextual;
+
+ sub call {
+ my $code = shift;
+ my $wantarray = [caller(1)]->[5];
+ if ($wantarray) {
+ my @result = $code->();
+ bless {result => \@result, wantarray => $wantarray}, __PACKAGE__;
+ } elsif (defined $wantarray) {
+ my $result = $code->();
+ bless {result => $result, wantarray => $wantarray}, __PACKAGE__;
+ } else {
+ { ; $code->(); } # void context
+ bless {wantarray => $wantarray}, __PACKAGE__;
+ }
+ }
+
+ sub result {
+ my $self = shift;
+ if ($self->{wantarray}) {
+ return @{ $self->{result} };
+ } elsif (defined $self->{wantarray}) {
+ return $self->{result};
+ } else {
+ return;
+ }
+ }
+}
my $STORE;
BEGIN {
- $STORE = Test::SharedFork::Store->new(
- cb => sub {
- my $store = shift;
- tie __PACKAGE__->builder->{Curr_Test}, 'Test::SharedFork::Scalar', $store;
- tie @{ __PACKAGE__->builder->{Test_Results} }, 'Test::SharedFork::Array', $store;
- },
- builder => __PACKAGE__->builder,
- );
+ my $builder = __PACKAGE__->builder;
+ if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
+ die "# Current version of Test::SharedFork does not supports ithreads.";
+ }
+
+ if (Test::Builder->VERSION > 2.00) {
+ # new Test::Builder
+ $STORE = Test::SharedFork::Store->new();
+
+ our $level = 0;
+ for my $class (qw/Test::Builder2::History Test::Builder2::Counter/) {
+ my $meta = $class->meta;
+ my @methods = $meta->get_method_list;
+ my $orig =
+ $class eq 'Test::Builder2::History'
+ ? $builder->{History}
+ : $builder->{History}->counter;
+ $orig->{test_sharedfork_hacked}++;
+ $STORE->set($class => $orig);
+ for my $method (@methods) {
+ next if $method =~ /^_/;
+ next if $method eq 'meta';
+ next if $method eq 'create';
+ next if $method eq 'singleton';
+ $meta->add_around_method_modifier(
+ $method => sub {
+ my ($code, $orig_self, @args) = @_;
+ return $orig_self->$code(@args) if (! ref $orig_self) || ! $orig_self->{test_sharedfork_hacked};
+
+ my $lock = $STORE->get_lock();
+ local $level = $level + 1;
+ my $self =
+ $level == 1 ? $STORE->get($class) : $orig_self;
+
+ my $ret = Test::SharedFork::Contextual::call(sub { $self->$code(@args) });
+ $STORE->set($class => $self);
+ return $ret->result;
+ },
+ );
+ }
+ }
+ } else {
+ # older Test::Builder
+ $STORE = Test::SharedFork::Store->new(
+ cb => sub {
+ my $store = shift;
+ tie $builder->{Curr_Test}, 'Test::SharedFork::Scalar',
+ $store, 'Curr_Test';
+ tie @{ $builder->{Test_Results} },
+ 'Test::SharedFork::Array', $store, 'Test_Results';
+ },
+ init => +{
+ Test_Results => $builder->{Test_Results},
+ Curr_Test => $builder->{Curr_Test},
+ },
+ );
+ }
+
+ # make methods atomic.
no strict 'refs';
no warnings 'redefine';
for my $name (qw/ok skip todo_skip current_test/) {
my $orig = *{"Test::Builder::${name}"}{CODE};
*{"Test::Builder::${name}"} = sub {
- local $Test::Builder::Level += 4;
- my @args = @_;
- $STORE->lock_cb(sub {
- $orig->(@args);
- });
+ local $Test::Builder::Level += 3;
+ my $lock = $STORE->get_lock(); # RAII
+ $orig->(@_);
};
};
+
}
{
@@ -73,6 +155,10 @@
This module merges test count with parent process & child process.
+=head1 LIMITATIONS
+
+This version of the Test::SharedFork does not support ithreads, because L<threads::shared> conflicts with L<Storable>.
+
=head1 AUTHOR
Tokuhiro Matsuno E<lt>tokuhirom slkjfd gmail.comE<gt>
Modified: trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Array.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Array.pm?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Array.pm (original)
+++ trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Array.pm Tue Sep 14 17:26:56 2010
@@ -6,15 +6,17 @@
# create new tied array
sub TIEARRAY {
- my ($class, $share) = @_;
- my $self = bless { share => $share }, $class;
+ my ($class, $share, $key) = @_;
+ die "missing key" unless $key;
+ my $self = bless { share => $share, key => $key }, $class;
$self;
}
sub _get {
my $self = shift;
- return $self->{share}->get('array');
+ my $lock = $self->{share}->get_lock();
+ return $self->{share}->get($self->{key});
}
sub FETCH {
my ($self, $index) = @_;
@@ -29,12 +31,12 @@
sub STORE {
my ($self, $index, $val) = @_;
- $self->{share}->lock_cb(sub {
- my $share = $self->{share};
- my $cur = $share->get_nolock('array');
- $cur->[$index] = $val;
- $share->set_nolock(array => $cur);
- });
+ my $lock = $self->{share}->get_lock();
+
+ my $share = $self->{share};
+ my $cur = $share->get($self->{key});
+ $cur->[$index] = $val;
+ $share->set($self->{key} => $cur);
}
1;
Modified: trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Scalar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Scalar.pm?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Scalar.pm (original)
+++ trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Scalar.pm Tue Sep 14 17:26:56 2010
@@ -5,19 +5,22 @@
# create new tied scalar
sub TIESCALAR {
- my ($class, $share) = @_;
- bless { share => $share }, $class;
+ my ($class, $share, $key) = @_;
+ die "missing key" unless $key;
+ bless { share => $share, key => $key }, $class;
}
sub FETCH {
my $self = shift;
- $self->{share}->get('scalar');
+ my $lock = $self->{share}->get_lock();
+ $self->{share}->get($self->{key});
}
sub STORE {
my ($self, $val) = @_;
my $share = $self->{share};
- $share->set('scalar' => $val);
+ my $lock = $self->{share}->get_lock();
+ $share->set($self->{key} => $val);
}
1;
Modified: trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Store.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Store.pm?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Store.pm (original)
+++ trunk/libtest-sharedfork-perl/lib/Test/SharedFork/Store.pm Tue Sep 14 17:26:56 2010
@@ -11,12 +11,15 @@
my %args = @_;
my $filename = File::Temp::tmpnam();
- my $init = Storable::dclone({
- array => $args{builder}->{Test_Results},
- scalar => $args{builder}->{Curr_Test},
- });
+ my $init = Storable::dclone($args{init} || +{});
- my $self = bless {callback_on_open => $args{cb}, filename => $filename, lock => 0, pid => $$, ppid => $$}, $class;
+ my $self = bless {
+ callback_on_open => $args{cb},
+ filename => $filename,
+ lock => 0,
+ pid => $$,
+ ppid => $$,
+ }, $class;
$self->open();
# initialize
@@ -43,31 +46,12 @@
sub get {
my ($self, $key) = @_;
-
- $self->_reopen_if_needed;
- my $ret = $self->lock_cb(sub {
- $self->get_nolock($key);
- }, LOCK_SH);
- return $ret;
-}
-
-sub get_nolock {
- my ($self, $key) = @_;
$self->_reopen_if_needed;
seek $self->{fh}, 0, SEEK_SET or die $!;
Storable::fd_retrieve($self->{fh})->{$key};
}
sub set {
- my ($self, $key, $val) = @_;
-
- $self->_reopen_if_needed;
- $self->lock_cb(sub {
- $self->set_nolock($key, $val);
- }, LOCK_EX);
-}
-
-sub set_nolock {
my ($self, $key, $val) = @_;
$self->_reopen_if_needed;
@@ -81,23 +65,9 @@
Storable::nstore_fd($dat => $self->{fh}) or die "Cannot store data to $self->{filename}";
}
-sub lock_cb {
- my ($self, $cb) = @_;
-
- $self->_reopen_if_needed;
-
- if ($self->{lock}++ == 0) {
- flock $self->{fh}, LOCK_EX or die $!;
- }
-
- my $ret = $cb->();
-
- $self->{lock}--;
- if ($self->{lock} == 0) {
- flock $self->{fh}, LOCK_UN or die $!;
- }
-
- $ret;
+sub get_lock {
+ my ($self, ) = @_;
+ Test::SharedFork::Store::Locker->new($self);
}
sub _reopen_if_needed {
@@ -120,4 +90,30 @@
}
}
+package # hide from pause
+ Test::SharedFork::Store::Locker;
+
+use Fcntl ':flock';
+
+sub new {
+ my ($class, $store) = @_;
+
+ $store->_reopen_if_needed;
+
+ if ($store->{lock}++ == 0) {
+ flock $store->{fh}, LOCK_EX or die $!;
+ }
+
+ bless { store => $store }, $class;
+}
+
+sub DESTROY {
+ my ($self) = @_;
+
+ $self->{store}->{lock}--;
+ if ($self->{store}->{lock} == 0) {
+ flock $self->{store}->{fh}, LOCK_UN or die $!;
+ }
+}
+
1;
Modified: trunk/libtest-sharedfork-perl/t/store/01_tie_scalar.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/t/store/01_tie_scalar.t?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/t/store/01_tie_scalar.t (original)
+++ trunk/libtest-sharedfork-perl/t/store/01_tie_scalar.t Tue Sep 14 17:26:56 2010
@@ -5,7 +5,7 @@
use Test::More tests => 1;
my $store = Test::SharedFork::Store->new();
-tie my $x, 'Test::SharedFork::Scalar', $store;
+tie my $x, 'Test::SharedFork::Scalar', $store, 'scalar';
$x = 3;
is $x, 3;
Modified: trunk/libtest-sharedfork-perl/t/store/02_tie_array.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/t/store/02_tie_array.t?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/t/store/02_tie_array.t (original)
+++ trunk/libtest-sharedfork-perl/t/store/02_tie_array.t Tue Sep 14 17:26:56 2010
@@ -5,7 +5,7 @@
use Test::More tests => 1;
my $store = Test::SharedFork::Store->new();
-tie my @x, 'Test::SharedFork::Array', $store;
+tie my @x, 'Test::SharedFork::Array', $store, 'array';
$x[0] = 3;
is $x[0], 3;
Modified: trunk/libtest-sharedfork-perl/xt/01_podspell.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-sharedfork-perl/xt/01_podspell.t?rev=62560&op=diff
==============================================================================
--- trunk/libtest-sharedfork-perl/xt/01_podspell.t (original)
+++ trunk/libtest-sharedfork-perl/xt/01_podspell.t Tue Sep 14 17:26:56 2010
@@ -12,3 +12,4 @@
kazuhooku
FAQ
konbuizm
+ithreads
More information about the Pkg-perl-cvs-commits
mailing list