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',
  50     'Singleton->instance returns a real instance' );
  51
  52 is( $mst->distinct_keys, 1, "default keys" );
  53
  54 $mst->add( foo => 10 );
  55 is( $mst->distinct_keys, 2, "added key" );
  56
  57 $mst->add( bar => 5 );
  58 is( $mst->distinct_keys, 3, "added another key" );
  59
  60 my $mst2 = MooseX::Singleton::Test->instance;
  61 is( $mst, $mst2, 'instances are the same object' );
  62 isa_ok( $mst2, 'MooseX::Singleton::Test',
  63     'Singleton->instance returns a real instance' );
  64
  65 is( $mst2->distinct_keys, 3, "keys from before" );
  66
  67 $mst->add( baz => 2 );
  68
  69 is( $mst->distinct_keys,  4, "attributes are shared even after ->instance" );
  70 is( $mst2->distinct_keys, 4, "attributes are shared even after ->instance" );
  71
  72 is( MooseX::Singleton::Test->distinct_keys, 4, "Package->reader works" );
  73
  74 MooseX::Singleton::Test->add( quux => 9000 );
  75
  76 is( $mst->distinct_keys,                    5, "Package->add works" );
  77 is( $mst2->distinct_keys,                   5, "Package->add works" );
  78 is( MooseX::Singleton::Test->distinct_keys, 5, "Package->add works" );
  79
  80 MooseX::Singleton::Test->clear;
  81
  82 is( $mst->distinct_keys,                    0, "Package->clear works" );
  83 is( $mst2->distinct_keys,                   0, "Package->clear works" );
  84 is( MooseX::Singleton::Test->distinct_keys, 0, "Package->clear works" );
  85
  86 {
  87     my $addr;
  88
  89     {
  90         $addr = refaddr( MooseX::Singleton::Test->instance );
  91     }
  92
  93     is(
  94         $addr, refaddr( MooseX::Singleton::Test->instance ),
  95         'singleton is not randomly destroyed'
  96     );
  97 }