t/003-immutable.t

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