4 use Scalar::Util qw( refaddr );
9 plan skip_all => 'These tests require Test::Warn' if $@;
13 package MooseX::Singleton::Test;
14 use MooseX::Singleton;
18 isa => 'HashRef[Int]',
19 default => sub { { default => 42 } },
24 scalar keys %{ $self->bag };
35 my $value = @_ ? shift : 1;
37 $self->bag->{$key} += $value;
40 ::warning_is sub { __PACKAGE__->meta->make_immutable }, '',
41 'no warnings when calling make_immutable';
44 my $mst = MooseX::Singleton::Test->instance;
45 isa_ok( $mst, 'MooseX::Singleton::Test',
46 'Singleton->instance returns a real instance' );
48 is( $mst->distinct_keys, 1, "default keys" );
50 $mst->add( foo => 10 );
51 is( $mst->distinct_keys, 2, "added key" );
53 $mst->add( bar => 5 );
54 is( $mst->distinct_keys, 3, "added another key" );
56 my $mst2 = MooseX::Singleton::Test->instance;
57 is( $mst, $mst2, 'instances are the same object' );
58 isa_ok( $mst2, 'MooseX::Singleton::Test',
59 'Singleton->instance returns a real instance' );
61 is( $mst2->distinct_keys, 3, "keys from before" );
63 $mst->add( baz => 2 );
65 is( $mst->distinct_keys, 4, "attributes are shared even after ->instance" );
66 is( $mst2->distinct_keys, 4, "attributes are shared even after ->instance" );
68 is( MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works" );
70 MooseX::Singleton::Test->add( quux => 9000 );
72 is( $mst->distinct_keys, 5, "Package->add works" );
73 is( $mst2->distinct_keys, 5, "Package->add works" );
74 is( MooseX::Singleton::Test->distinct_keys, 5, "Package->add works" );
76 MooseX::Singleton::Test->clear;
78 is( $mst->distinct_keys, 0, "Package->clear works" );
79 is( $mst2->distinct_keys, 0, "Package->clear works" );
80 is( MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works" );
86 $addr = refaddr( MooseX::Singleton::Test->instance );
90 $addr, refaddr( MooseX::Singleton::Test->instance ),
91 'singleton is not randomly destroyed'