t/001-basic.t

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