4 use Scalar::Util qw( refaddr );
8 unless ( eval 'use Test::Warn; 1' ) {
9 plan skip_all => 'These tests require Test::Warn';
17 package MooseX::Singleton::Test;
18 use MooseX::Singleton;
22 isa => 'HashRef[Int]',
23 default => sub { { default => 42 } },
28 scalar keys %{ $self->bag };
39 my $value = @_ ? shift : 1;
41 $self->bag->{$key} += $value;
44 ::warning_is sub { __PACKAGE__->meta->make_immutable }, '',
45 'no warnings when calling make_immutable';
48 my $mst = MooseX::Singleton::Test->instance;
49 isa_ok($mst, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
51 is($mst->distinct_keys, 1, "default keys");
54 is($mst->distinct_keys, 2, "added key");
57 is($mst->distinct_keys, 3, "added another key");
59 my $mst2 = MooseX::Singleton::Test->instance;
60 is($mst, $mst2, 'instances are the same object');
61 isa_ok($mst2, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
63 is($mst2->distinct_keys, 3, "keys from before");
67 is($mst->distinct_keys, 4, "attributes are shared even after ->instance");
68 is($mst2->distinct_keys, 4, "attributes are shared even after ->instance");
70 is(MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works");
72 MooseX::Singleton::Test->add(quux => 9000);
74 is($mst->distinct_keys, 5, "Package->add works");
75 is($mst2->distinct_keys, 5, "Package->add works");
76 is(MooseX::Singleton::Test->distinct_keys, 5, "Package->add works");
78 MooseX::Singleton::Test->clear;
80 is($mst->distinct_keys, 0, "Package->clear works");
81 is($mst2->distinct_keys, 0, "Package->clear works");
82 is(MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works");
88 $addr = refaddr( MooseX::Singleton::Test->instance );
91 is( $addr, refaddr( MooseX::Singleton::Test->instance ),
92 'singleton is not randomly destroyed' );