r49381 - in /trunk/libmoosex-singleton-perl: ./ debian/ inc/Module/Install/ lib/MooseX/ lib/MooseX/Singleton/Role/ lib/MooseX/Singleton/Role/Meta/ lib/MooseX/Singleton/Role/Meta/Method/ t/ xt/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Dec 25 16:26:17 UTC 2009
Author: jawnsy-guest
Date: Fri Dec 25 16:26:11 2009
New Revision: 49381
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49381
Log:
* New upstream release
* Update ryan52's email address
Added:
trunk/libmoosex-singleton-perl/inc/Module/Install/ExtraTests.pm
- copied unchanged from r49380, branches/upstream/libmoosex-singleton-perl/current/inc/Module/Install/ExtraTests.pm
trunk/libmoosex-singleton-perl/xt/
- copied from r49380, branches/upstream/libmoosex-singleton-perl/current/xt/
Modified:
trunk/libmoosex-singleton-perl/ChangeLog
trunk/libmoosex-singleton-perl/MANIFEST
trunk/libmoosex-singleton-perl/META.yml
trunk/libmoosex-singleton-perl/Makefile.PL
trunk/libmoosex-singleton-perl/debian/changelog
trunk/libmoosex-singleton-perl/debian/control
trunk/libmoosex-singleton-perl/debian/copyright
trunk/libmoosex-singleton-perl/lib/MooseX/Singleton.pm
trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Class.pm
trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Instance.pm
trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Object.pm
trunk/libmoosex-singleton-perl/t/001-basic.t
trunk/libmoosex-singleton-perl/t/002-init.t
trunk/libmoosex-singleton-perl/t/003-immutable.t
trunk/libmoosex-singleton-perl/t/004-build_bug.t
trunk/libmoosex-singleton-perl/t/005-build_bug-immutable.t
trunk/libmoosex-singleton-perl/t/006-cooperative.t
Modified: trunk/libmoosex-singleton-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/ChangeLog?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/ChangeLog (original)
+++ trunk/libmoosex-singleton-perl/ChangeLog Fri Dec 25 16:26:11 2009
@@ -1,9 +1,16 @@
Revision history for Perl extension MooseX-Singleton
+0.22 2009-12-25
+ - The ->initialize method was both broken and undocumented. RT
+ #51260. (Dave Rolsky)
+ - Updated docs to encourage use of ->instance and ->initialize, and
+ discourage calling ->new directly. Doing so may be deprecated in a
+ future release. (Dave Rolsky)
+
0.21 2009-09-12
- Various modules in this class were trying to load the old pre-0.20
classes, which have all been renamed. Tests passed if you had 0.19 or
- earlier installed, but failed for fresh installations. (Dave Rolsky)
+ earlier installed, but failed for fresh installations. (Dave Rolsky)
0.20 2009-09-11
- Converted this extension to use roles rather than metaclass
Modified: trunk/libmoosex-singleton-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/MANIFEST?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/MANIFEST (original)
+++ trunk/libmoosex-singleton-perl/MANIFEST Fri Dec 25 16:26:11 2009
@@ -2,6 +2,7 @@
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
+inc/Module/Install/ExtraTests.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
@@ -21,3 +22,8 @@
t/004-build_bug.t
t/005-build_bug-immutable.t
t/006-cooperative.t
+xt/author/pod-coverage.t
+xt/author/pod-spell.t
+xt/author/pod.t
+xt/author/tabs.t
+xt/author/version-numbers.t
Modified: trunk/libmoosex-singleton-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/META.yml?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/META.yml (original)
+++ trunk/libmoosex-singleton-perl/META.yml Fri Dec 25 16:26:11 2009
@@ -4,8 +4,9 @@
- 'Shawn M Moore <sartak at gmail.com>'
build_requires:
ExtUtils::MakeMaker: 6.42
+ Scalar::Util: 0
Test::Exception: 0
- Test::More: 0
+ Test::More: 0.88
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
@@ -19,8 +20,9 @@
directory:
- inc
- t
+ - xt
requires:
Moose: 0.82
resources:
license: http://dev.perl.org/licenses/
-version: 0.21
+version: 0.22
Modified: trunk/libmoosex-singleton-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/Makefile.PL?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/Makefile.PL (original)
+++ trunk/libmoosex-singleton-perl/Makefile.PL Fri Dec 25 16:26:11 2009
@@ -7,9 +7,12 @@
requires 'Moose' => '0.82';
-build_requires 'Test::More';
+build_requires 'Scalar::Util';
+build_requires 'Test::More' => '0.88';
build_requires 'Test::Exception';
license 'Perl';
+extra_tests();
+
WriteAll();
Modified: trunk/libmoosex-singleton-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/debian/changelog?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/debian/changelog (original)
+++ trunk/libmoosex-singleton-perl/debian/changelog Fri Dec 25 16:26:11 2009
@@ -1,12 +1,13 @@
-libmoosex-singleton-perl (0.21-2) UNRELEASED; urgency=low
+libmoosex-singleton-perl (0.22-1) UNRELEASED; urgency=low
+
+ [ Jonathan Yu ]
+ * New upstream release
+ * Update short description
[ Ryan Niebur ]
* Update ryan52's email address
- [ Jonathan Yu ]
- * Update short description
-
- -- Jonathan Yu <jawnsy at cpan.org> Fri, 20 Nov 2009 20:23:44 -0500
+ -- Jonathan Yu <jawnsy at cpan.org> Fri, 25 Dec 2009 08:16:40 -0500
libmoosex-singleton-perl (0.21-1) unstable; urgency=low
Modified: trunk/libmoosex-singleton-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/debian/control?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/debian/control (original)
+++ trunk/libmoosex-singleton-perl/debian/control Fri Dec 25 16:26:11 2009
@@ -3,7 +3,8 @@
Priority: optional
Build-Depends: debhelper (>= 7)
Build-Depends-Indep: perl, libtest-exception-perl, libmoose-perl (>= 0.82),
- libtest-warn-perl, libmoosex-strictconstructor-perl
+ libtest-warn-perl, libmoosex-strictconstructor-perl,
+ perl (>= 5.10.1) | libtest-simple-perl (>= 0.88)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Ryan Niebur <ryan at debian.org>, Jonathan Yu <jawnsy at cpan.org>
Standards-Version: 3.8.3
Modified: trunk/libmoosex-singleton-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/debian/copyright?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/debian/copyright (original)
+++ trunk/libmoosex-singleton-perl/debian/copyright Fri Dec 25 16:26:11 2009
@@ -5,7 +5,7 @@
Upstream-Name: MooseX-Singleton
Files: *
-Copyright: 2007, 2008 Infinity Interactive
+Copyright: 2007-2008, Infinity Interactive
License-Alias: Perl
License: Artistic | GPL-1+
Modified: trunk/libmoosex-singleton-perl/lib/MooseX/Singleton.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/lib/MooseX/Singleton.pm?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/lib/MooseX/Singleton.pm (original)
+++ trunk/libmoosex-singleton-perl/lib/MooseX/Singleton.pm Fri Dec 25 16:26:11 2009
@@ -6,7 +6,7 @@
use MooseX::Singleton::Role::Meta::Class;
use MooseX::Singleton::Role::Meta::Instance;
-our $VERSION = '0.21';
+our $VERSION = '0.22';
$VERSION = eval $VERSION;
Moose::Exporter->setup_import_methods( also => 'Moose' );
@@ -72,38 +72,43 @@
L<Moose> class to a singleton.
All you should need to do to transform your class is to change C<use Moose> to
-C<use MooseX::Singleton>. This module uses a new class metaclass and instance
-metaclass, so if you're doing metamagic you may not be able to use this.
+C<use MooseX::Singleton>. This module uses metaclass roles to do its magic, so
+it should cooperate with most other C<MooseX> modules.
-C<MooseX::Singleton> gives your class an C<instance> method that can be used to
-get a handle on the singleton. It's actually just an alias for C<new>.
+=head1 METHODS
-Alternatively, C<< YourPackage->method >> should just work. This includes
-accessors.
+A singleton class will have the following additional methods:
-If you need to reset your class's singleton object for some reason (e.g.
-tests), you can call C<< YourPackage->_clear_instance >>.
+=head2 Singleton->instance
-=head1 TODO
+This returns the singleton instance for the given package. This method does
+I<not> accept any arguments. If the instance does not yet exist, it is created
+with its defaults values. This means that if your singleton requires
+arguments, calling C<instance> will die if the object has not already been
+initialized.
-=over
+=head2 Singleton->initialize(%args)
-=item Always more tests and doc
+This method can be called I<only once per class>. It explicitly initializes
+the singleton object with the given arguments.
-=item Fix speed boost
+=head2 Singleton->_clear_instance
-C<instance> invokes C<new> every time C<< Package->method >> is called, which
-incurs a nontrivial runtime cost. I've implemented a short-circuit for this
-case, which does eliminate nearly all of the runtime cost. However, it's ugly
-and should be fixed in a more elegant way.
+This clears the existing singleton instance for the class. Obviously, this is
+meant for use only inside the class itself.
-=back
+=head2 Singleton->new
+
+This method currently works like a hybrid of C<initialize> and
+C<instance>. However, calling C<new> directly will probably be deprecated in a
+future release. Instead, call C<initialize> or C<instance> as appropriate.
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+Please report any bugs or feature requests to
+C<bug-moosex-singleton at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>. We will be notified, and then you'll automatically be
+notified of progress on your bug as we make changes.
=head1 AUTHORS
@@ -121,7 +126,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2007, 2008 Infinity Interactive
+Copyright 2007-2009 Infinity Interactive
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
Modified: trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Class.pm?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Class.pm (original)
+++ trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Class.pm Fri Dec 25 16:26:11 2009
@@ -1,8 +1,10 @@
-#!/usr/bin/env perl
package MooseX::Singleton::Role::Meta::Class;
use Moose::Role;
use MooseX::Singleton::Role::Meta::Instance;
use MooseX::Singleton::Role::Meta::Method::Constructor;
+
+our $VERSION = '0.22';
+$VERSION = eval $VERSION;
sub existing_singleton {
my ($class) = @_;
@@ -11,7 +13,7 @@
no strict 'refs';
# create exactly one instance
- if (defined ${"$pkg\::singleton"}) {
+ if ( defined ${"$pkg\::singleton"} ) {
return ${"$pkg\::singleton"};
}
@@ -37,7 +39,7 @@
return ${"$pkg\::singleton"} = super;
};
-no Moose;
+no Moose::Role;
1;
Modified: trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Instance.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Instance.pm?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Instance.pm (original)
+++ trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Instance.pm Fri Dec 25 16:26:11 2009
@@ -1,10 +1,12 @@
-#!/usr/bin/env perl
package MooseX::Singleton::Role::Meta::Instance;
use Moose::Role;
use Scalar::Util 'weaken';
+our $VERSION = '0.22';
+$VERSION = eval $VERSION;
+
sub get_singleton_instance {
- my ($self, $instance) = @_;
+ my ( $self, $instance ) = @_;
return $instance if blessed $instance;
@@ -19,42 +21,45 @@
return $instance->meta->name->new;
}
-override clone_instance => sub {
- my ($self, $instance) = @_;
+override clone_instance => sub {
+ my ( $self, $instance ) = @_;
$self->get_singleton_instance($instance);
};
-override get_slot_value => sub {
- my ($self, $instance, $slot_name) = @_;
- $self->is_slot_initialized($instance, $slot_name) ? $self->get_singleton_instance($instance)->{$slot_name} : undef;
+override get_slot_value => sub {
+ my ( $self, $instance, $slot_name ) = @_;
+ $self->is_slot_initialized( $instance, $slot_name )
+ ? $self->get_singleton_instance($instance)->{$slot_name}
+ : undef;
};
-override set_slot_value => sub {
- my ($self, $instance, $slot_name, $value) = @_;
+override set_slot_value => sub {
+ my ( $self, $instance, $slot_name, $value ) = @_;
$self->get_singleton_instance($instance)->{$slot_name} = $value;
};
-override deinitialize_slot => sub {
+override deinitialize_slot => sub {
my ( $self, $instance, $slot_name ) = @_;
delete $self->get_singleton_instance($instance)->{$slot_name};
};
-override is_slot_initialized => sub {
- my ($self, $instance, $slot_name, $value) = @_;
+override is_slot_initialized => sub {
+ my ( $self, $instance, $slot_name, $value ) = @_;
exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0;
};
-override weaken_slot_value => sub {
- my ($self, $instance, $slot_name) = @_;
+override weaken_slot_value => sub {
+ my ( $self, $instance, $slot_name ) = @_;
weaken $self->get_singleton_instance($instance)->{$slot_name};
};
-override inline_slot_access => sub {
- my ($self, $instance, $slot_name) = @_;
- sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}", $instance, $instance, $slot_name;
+override inline_slot_access => sub {
+ my ( $self, $instance, $slot_name ) = @_;
+ sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}",
+ $instance, $instance, $slot_name;
};
-no Moose;
+no Moose::Role;
1;
Modified: trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm (original)
+++ trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Meta/Method/Constructor.pm Fri Dec 25 16:26:11 2009
@@ -1,9 +1,12 @@
-#!/usr/bin/env perl
package MooseX::Singleton::Role::Meta::Method::Constructor;
use Moose::Role;
+our $VERSION = '0.22';
+$VERSION = eval $VERSION;
+
override _initialize_body => sub {
my $self = shift;
+
# TODO:
# the %options should also include a both
# a call 'initializer' and call 'SUPER::'
@@ -14,14 +17,18 @@
my $source = 'sub {';
$source .= "\n" . 'my $class = shift;';
- $source .= "\n" . 'my $existing = do { no strict "refs"; no warnings "once"; \${"$class\::singleton"}; };';
+ $source .= "\n"
+ . 'my $existing = do { no strict "refs"; no warnings "once"; \${"$class\::singleton"}; };';
$source .= "\n" . 'return ${$existing} if ${$existing};';
$source .= "\n" . 'return $class->Moose::Object::new(@_)';
- $source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';';
+ $source
+ .= "\n"
+ . ' if $class ne \''
+ . $self->associated_metaclass->name . '\';';
- $source .= $self->_generate_params('$params', '$class');
- $source .= $self->_generate_instance('$instance', '$class');
+ $source .= $self->_generate_params( '$params', '$class' );
+ $source .= $self->_generate_instance( '$instance', '$class' );
$source .= $self->_generate_slot_initializers;
$source .= ";\n" . $self->_generate_triggers();
@@ -33,25 +40,27 @@
my $attrs = $self->_attributes;
- my @type_constraints = map {
- $_->can('type_constraint') ? $_->type_constraint : undef
- } @$attrs;
+ my @type_constraints
+ = map { $_->can('type_constraint') ? $_->type_constraint : undef }
+ @$attrs;
- my @type_constraint_bodies = map {
- defined $_ ? $_->_compiled_type_constraint : undef;
- } @type_constraints;
+ my @type_constraint_bodies
+ = map { defined $_ ? $_->_compiled_type_constraint : undef; }
+ @type_constraints;
my ( $code, $e ) = $self->_compile_code(
- code => $source,
+ code => $source,
environment => {
- '$meta' => \$self,
- '$attrs' => \$attrs,
- '@type_constraints' => \@type_constraints,
+ '$meta' => \$self,
+ '$attrs' => \$attrs,
+ '@type_constraints' => \@type_constraints,
'@type_constraint_bodies' => \@type_constraint_bodies,
},
);
- $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e", error => $e, data => $source )
+ $self->throw_error(
+ "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e",
+ error => $e, data => $source )
if $e;
$self->{'body'} = $code;
@@ -80,6 +89,22 @@
return $super_value;
};
-no Moose;
+no Moose::Role;
1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Singleton::Role::Meta::Method::Constructor - Constructor method role for MooseX::Singleton
+
+=head1 DESCRIPTION
+
+This role overrides the generated object C<new> method so that it returns the
+singleton if it already exists.
+
+=cut
+
Modified: trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Object.pm?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Object.pm (original)
+++ trunk/libmoosex-singleton-perl/lib/MooseX/Singleton/Role/Object.pm Fri Dec 25 16:26:11 2009
@@ -1,37 +1,40 @@
-#!/usr/bin/env perl
package MooseX::Singleton::Role::Object;
use Moose::Role;
+use Carp qw( carp );
+
+our $VERSION = '0.22';
+$VERSION = eval $VERSION;
sub instance { shift->new }
sub initialize {
- my ($class, @args) = @_;
+ my ( $class, @args ) = @_;
- my $existing = $class->meta->existing_singleton;
- confess "Singleton is already initialized" if $existing;
+ my $existing = $class->meta->existing_singleton;
+ confess "Singleton is already initialized" if $existing;
- return $class->SUPER::new(@args);
+ return $class->new(@args);
}
override new => sub {
- my ($class, @args) = @_;
+ my ( $class, @args ) = @_;
- my $existing = $class->meta->existing_singleton;
- confess "Singleton is already initialized" if $existing and @args;
+ my $existing = $class->meta->existing_singleton;
+ confess "Singleton is already initialized" if $existing and @args;
- # Otherwise BUILD will be called repeatedly on the existing instance.
- # -- rjbs, 2008-02-03
- return $existing if $existing and ! @args;
+ # Otherwise BUILD will be called repeatedly on the existing instance.
+ # -- rjbs, 2008-02-03
+ return $existing if $existing and !@args;
- return super();
+ return super();
};
sub _clear_instance {
- my ($class) = @_;
- $class->meta->clear_singleton;
+ my ($class) = @_;
+ $class->meta->clear_singleton;
}
-no Moose;
+no Moose::Role;
1;
@@ -41,7 +44,7 @@
=head1 NAME
-MooseX::Singleton::Object - Object class role for MooseX::Singleton
+MooseX::Singleton::Role::Object - Object class role for MooseX::Singleton
=head1 DESCRIPTION
Modified: trunk/libmoosex-singleton-perl/t/001-basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/t/001-basic.t?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/t/001-basic.t (original)
+++ trunk/libmoosex-singleton-perl/t/001-basic.t Fri Dec 25 16:26:11 2009
@@ -1,6 +1,6 @@
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More;
BEGIN {
package MooseX::Singleton::Test;
@@ -19,12 +19,12 @@
sub clear {
my $self = shift;
- $self->bag({});
+ $self->bag( {} );
}
sub add {
- my $self = shift;
- my $key = shift;
+ my $self = shift;
+ my $key = shift;
my $value = @_ ? shift : 1;
$self->bag->{$key} += $value;
@@ -32,41 +32,45 @@
}
my $mst = MooseX::Singleton::Test->instance;
-isa_ok($mst, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+isa_ok( $mst, 'MooseX::Singleton::Test',
+ 'Singleton->instance returns a real instance' );
-is($mst->distinct_keys, 1, "default keys");
+is( $mst->distinct_keys, 1, "default keys" );
-$mst->add(foo => 10);
-is($mst->distinct_keys, 2, "added key");
+$mst->add( foo => 10 );
+is( $mst->distinct_keys, 2, "added key" );
-$mst->add(bar => 5);
-is($mst->distinct_keys, 3, "added another key");
+$mst->add( bar => 5 );
+is( $mst->distinct_keys, 3, "added another key" );
my $mst2 = MooseX::Singleton::Test->instance;
-is($mst, $mst2, 'instances are the same object');
-isa_ok($mst2, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+is( $mst, $mst2, 'instances are the same object' );
+isa_ok( $mst2, 'MooseX::Singleton::Test',
+ 'Singleton->instance returns a real instance' );
-is($mst2->distinct_keys, 3, "keys from before");
+is( $mst2->distinct_keys, 3, "keys from before" );
-$mst->add(baz => 2);
+$mst->add( baz => 2 );
-is($mst->distinct_keys, 4, "attributes are shared even after ->instance");
-is($mst2->distinct_keys, 4, "attributes are shared even after ->instance");
+is( $mst->distinct_keys, 4, "attributes are shared even after ->instance" );
+is( $mst2->distinct_keys, 4, "attributes are shared even after ->instance" );
-is(MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works");
+is( MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works" );
-MooseX::Singleton::Test->add(quux => 9000);
+MooseX::Singleton::Test->add( quux => 9000 );
-is($mst->distinct_keys, 5, "Package->add works");
-is($mst2->distinct_keys, 5, "Package->add works");
-is(MooseX::Singleton::Test->distinct_keys, 5, "Package->add works");
+is( $mst->distinct_keys, 5, "Package->add works" );
+is( $mst2->distinct_keys, 5, "Package->add works" );
+is( MooseX::Singleton::Test->distinct_keys, 5, "Package->add works" );
MooseX::Singleton::Test->clear;
-is($mst->distinct_keys, 0, "Package->clear works");
-is($mst2->distinct_keys, 0, "Package->clear works");
-is(MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works");
+is( $mst->distinct_keys, 0, "Package->clear works" );
+is( $mst2->distinct_keys, 0, "Package->clear works" );
+is( MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works" );
MooseX::Singleton::Test->_clear_instance;
$mst = $mst2 = undef;
-is(MooseX::Singleton::Test->new->distinct_keys, 1, "back to the default");
+is( MooseX::Singleton::Test->instance->distinct_keys, 1, "back to the default" );
+
+done_testing;
Modified: trunk/libmoosex-singleton-perl/t/002-init.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/t/002-init.t?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/t/002-init.t (original)
+++ trunk/libmoosex-singleton-perl/t/002-init.t Fri Dec 25 16:26:11 2009
@@ -1,6 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More;
+use Test::Exception;
my $i = 0;
sub new_singleton_pkg {
@@ -15,41 +16,53 @@
return $pkg_name;
}
-eval { new_singleton_pkg()->instance; };
-like(
- $@,
- qr/\QAttribute (number) is required/,
- q{can't get the Singleton if requires attrs and we don't provide them},
-);
+throws_ok { new_singleton_pkg()->instance }
+ qr/\QAttribute (number) is required/,
+ q{can't get the Singleton if requires attrs and we don't provide them};
-eval { new_singleton_pkg()->string; };
-like(
- $@,
- qr/\QAttribute (number) is required/,
- q{can't call any Singleton attr reader if Singleton can't be inited},
-);
+throws_ok { new_singleton_pkg()->string }
+ qr/\QAttribute (number) is required/,
+ q{can't call any Singleton attr reader if Singleton can't be inited};
for my $pkg (new_singleton_pkg) {
- my $mst = $pkg->new(number => 5);
- isa_ok($mst, $pkg);
+ my $mst = $pkg->new( number => 5 );
+ isa_ok( $mst, $pkg );
- is($mst->number, 5, "the instance has the given attribute value");
+ is( $mst->number, 5, "the instance has the given attribute value" );
- is(
- $pkg->number,
- 5,
- "the class method, called directly, returns the given attribute value"
- );
+ is(
+ $pkg->number,
+ 5,
+ "the class method, called directly, returns the given attribute value"
+ );
- eval { $pkg->new(number => 3) };
- like($@, qr/already/, "can't make new singleton with conflicting attributes");
+ throws_ok { $pkg->new( number => 3 ) }
+ qr/already/,
+ "can't make new singleton with conflicting attributes";
- my $second = eval { $pkg->new };
- ok(!$@, "...but a second ->new without args is okay");
+ my $second = eval { $pkg->new };
+ ok( !$@, "...but a second ->new without args is okay" );
- is($second->number, 5, "...we get the originally inited number from it");
+ is( $second->number, 5,
+ "...we get the originally inited number from it" );
- eval { $pkg->initialize };
- like($@, qr/already/, "...but ->initialize() is still an error");
+ throws_ok { $pkg->initialize }
+ qr/already/,
+ "...but ->initialize() is still an error";
}
+{
+ package Single;
+
+ use MooseX::Singleton;
+
+ has foo => ( is => 'ro' );
+}
+
+{
+ Single->initialize( foo => 2 );
+ ok( Single->new, 'can call ->new without any args' );
+ ok( Single->instance, 'can call ->instance without any args' );
+}
+
+done_testing;
Modified: trunk/libmoosex-singleton-perl/t/003-immutable.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/t/003-immutable.t?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/t/003-immutable.t (original)
+++ trunk/libmoosex-singleton-perl/t/003-immutable.t Fri Dec 25 16:26:11 2009
@@ -1,15 +1,12 @@
use strict;
use warnings;
+use Scalar::Util qw( refaddr );
use Test::More;
BEGIN {
- unless ( eval 'use Test::Warn; 1' ) {
- plan skip_all => 'These tests require Test::Warn';
- }
- else {
- plan tests => 17;
- }
+ eval 'use Test::Warn';
+ plan skip_all => 'These tests require Test::Warn' if $@;
}
{
@@ -29,54 +26,70 @@
sub clear {
my $self = shift;
- $self->bag({});
+ $self->bag( {} );
}
sub add {
- my $self = shift;
- my $key = shift;
+ my $self = shift;
+ my $key = shift;
my $value = @_ ? shift : 1;
$self->bag->{$key} += $value;
}
-__PACKAGE__->meta->make_immutable;
+
::warning_is sub { __PACKAGE__->meta->make_immutable }, '',
'no warnings when calling make_immutable';
}
my $mst = MooseX::Singleton::Test->instance;
-isa_ok($mst, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+isa_ok( $mst, 'MooseX::Singleton::Test',
+ 'Singleton->instance returns a real instance' );
-is($mst->distinct_keys, 1, "default keys");
+is( $mst->distinct_keys, 1, "default keys" );
-$mst->add(foo => 10);
-is($mst->distinct_keys, 2, "added key");
+$mst->add( foo => 10 );
+is( $mst->distinct_keys, 2, "added key" );
-$mst->add(bar => 5);
-is($mst->distinct_keys, 3, "added another key");
+$mst->add( bar => 5 );
+is( $mst->distinct_keys, 3, "added another key" );
my $mst2 = MooseX::Singleton::Test->instance;
-is($mst, $mst2, 'instances are the same object');
-isa_ok($mst2, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
+is( $mst, $mst2, 'instances are the same object' );
+isa_ok( $mst2, 'MooseX::Singleton::Test',
+ 'Singleton->instance returns a real instance' );
-is($mst2->distinct_keys, 3, "keys from before");
+is( $mst2->distinct_keys, 3, "keys from before" );
-$mst->add(baz => 2);
+$mst->add( baz => 2 );
-is($mst->distinct_keys, 4, "attributes are shared even after ->instance");
-is($mst2->distinct_keys, 4, "attributes are shared even after ->instance");
+is( $mst->distinct_keys, 4, "attributes are shared even after ->instance" );
+is( $mst2->distinct_keys, 4, "attributes are shared even after ->instance" );
-is(MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works");
+is( MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works" );
-MooseX::Singleton::Test->add(quux => 9000);
+MooseX::Singleton::Test->add( quux => 9000 );
-is($mst->distinct_keys, 5, "Package->add works");
-is($mst2->distinct_keys, 5, "Package->add works");
-is(MooseX::Singleton::Test->distinct_keys, 5, "Package->add works");
+is( $mst->distinct_keys, 5, "Package->add works" );
+is( $mst2->distinct_keys, 5, "Package->add works" );
+is( MooseX::Singleton::Test->distinct_keys, 5, "Package->add works" );
MooseX::Singleton::Test->clear;
-is($mst->distinct_keys, 0, "Package->clear works");
-is($mst2->distinct_keys, 0, "Package->clear works");
-is(MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works");
+is( $mst->distinct_keys, 0, "Package->clear works" );
+is( $mst2->distinct_keys, 0, "Package->clear works" );
+is( MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works" );
+{
+ my $addr;
+
+ {
+ $addr = refaddr( MooseX::Singleton::Test->instance );
+ }
+
+ is(
+ $addr, refaddr( MooseX::Singleton::Test->instance ),
+ 'singleton is not randomly destroyed'
+ );
+}
+
+done_testing;
Modified: trunk/libmoosex-singleton-perl/t/004-build_bug.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/t/004-build_bug.t?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/t/004-build_bug.t (original)
+++ trunk/libmoosex-singleton-perl/t/004-build_bug.t Fri Dec 25 16:26:11 2009
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More 'no_plan';
+use Test::More;
{
package MySingleton;
@@ -34,3 +34,5 @@
MySingleton->attrib, 'bar',
'BUILDARGS changed value of attrib when instance was explicitly instantiated'
);
+
+done_testing;
Modified: trunk/libmoosex-singleton-perl/t/005-build_bug-immutable.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/t/005-build_bug-immutable.t?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/t/005-build_bug-immutable.t (original)
+++ trunk/libmoosex-singleton-perl/t/005-build_bug-immutable.t Fri Dec 25 16:26:11 2009
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More 'no_plan';
+use Test::More;
{
package MySingleton;
@@ -36,3 +36,5 @@
MySingleton->attrib, 'bar',
'BUILDARGS changed value of attrib when instance was explicitly instantiated'
);
+
+done_testing;
Modified: trunk/libmoosex-singleton-perl/t/006-cooperative.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-singleton-perl/t/006-cooperative.t?rev=49381&op=diff
==============================================================================
--- trunk/libmoosex-singleton-perl/t/006-cooperative.t (original)
+++ trunk/libmoosex-singleton-perl/t/006-cooperative.t Fri Dec 25 16:26:11 2009
@@ -4,12 +4,11 @@
use Test::More;
BEGIN {
- eval "require MooseX::StrictConstructor; use Test::Exception; 1;";
- plan skip_all => 'This test requires MooseX::StrictConstructor and Test::Exception'
+ eval "require MooseX::StrictConstructor; use Test::Exception;";
+ plan skip_all =>
+ 'This test requires MooseX::StrictConstructor and Test::Exception'
if $@;
}
-
-plan 'no_plan';
{
package MySingleton;
@@ -17,12 +16,12 @@
use MooseX::Singleton;
use MooseX::StrictConstructor;
- has 'attrib' =>
- is => 'rw';
+ has 'attrib' => ( is => 'rw' );
}
throws_ok {
- MySingleton->new( bad_name => 42 )
+ MySingleton->new( bad_name => 42 );
}
-qr/Found unknown attribute/,
-'singleton class also has a strict constructor';
+qr/Found unknown attribute/, 'singleton class also has a strict constructor';
+
+done_testing;
More information about the Pkg-perl-cvs-commits
mailing list