t/003-immutable.t

   1 use strict;
   2 use warnings;
   3
   4 use Scalar::Util qw( refaddr );
   5 use Test::More;
   6
   7 BEGIN {
   8     unless ( eval 'use Test::Warn; 1' )  {
   9         plan skip_all => 'These tests require Test::Warn';
  10     }
  11     else {
  12         plan tests => 18;
  13     }
  14 }
  15
  16 {
  17     package MooseX::Singleton::Test;
  18     use MooseX::Singleton;
  19
  20     has bag => (
  21         is      => 'rw',
  22         isa     => 'HashRef[Int]',
  23         default => sub { { default => 42 } },
  24     );
  25
  26     sub distinct_keys {
  27         my $self = shift;
  28         scalar keys %{ $self->bag };
  29     }
  30
  31     sub clear {
  32         my $self = shift;
  33         $self->bag({});
  34     }
  35
  36     sub add {
  37         my $self = shift;
  38         my $key = shift;
  39         my $value = @_ ? shift : 1;
  40
  41         $self->bag->{$key} += $value;
  42     }
  43
  44     ::warning_is sub { __PACKAGE__->meta->make_immutable }, '',
  45         'no warnings when calling make_immutable';
  46 }
  47
  48 my $mst = MooseX::Singleton::Test->instance;
  49 isa_ok($mst, 'MooseX::Singleton::Test', 'Singleton->instance returns a real instance');
  50
  51 is($mst->distinct_keys, 1, "default keys");
  52
  53 $mst->add(foo => 10);
  54 is($mst->distinct_keys, 2, "added key");
  55
  56 $mst->add(bar => 5);
  57 is($mst->distinct_keys, 3, "added another key");
  58
  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');
  62
  63 is($mst2->distinct_keys, 3, "keys from before");
  64
  65 $mst->add(baz => 2);
  66
  67 is($mst->distinct_keys, 4, "attributes are shared even after ->instance");
  68 is($mst2->distinct_keys, 4, "attributes are shared even after ->instance");
  69
  70 is(MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works");
  71
  72 MooseX::Singleton::Test->add(quux => 9000);
  73
  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");
  77
  78 MooseX::Singleton::Test->clear;
  79
  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");
  83
  84 {
  85     my $addr;
  86
  87     {
  88         $addr = refaddr( MooseX::Singleton::Test->instance );
  89     }
  90
  91     is( $addr, refaddr( MooseX::Singleton::Test->instance ),
  92         'singleton is not randomly destroyed' );
  93 }
  94