t/003-immutable.t

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