#
# Class::Singleton test script
#
# Andy Wardley <abw@wardley.org>
#
use strict;
use warnings;
use Test::More tests => 29;
use lib qw( lib ../lib );
use Class::Singleton;
# the final test is run by a destructor which is called after Test::Builder
# would normally print the test summary, so we disable that
Test::More->builder->no_ending(1);
ok(1, 'loaded Class::Singleton');
#------------------------------------------------------------------------
# define 'DerivedSingleton', a class derived from Class::Singleton
#------------------------------------------------------------------------
package DerivedSingleton;
use base 'Class::Singleton';
#------------------------------------------------------------------------
# define 'AnotherSingleton', a class derived from DerivedSingleton
#------------------------------------------------------------------------
package AnotherSingleton;
use base 'DerivedSingleton';
sub x {
shift->{ x };
}
#------------------------------------------------------------------------
# define 'ListSingleton', which uses a list reference as its type
#------------------------------------------------------------------------
package ListSingleton;
use base 'Class::Singleton';
sub _new_instance {
my $class = shift;
bless [], $class;
}
#------------------------------------------------------------------------
# define 'ConfigSingleton', which has specific configuration needs.
#------------------------------------------------------------------------
package ConfigSingleton;
use base 'Class::Singleton';
sub _new_instance {
my $class = shift;
my $config = shift || { };
my $self = {
'one' => 'This is the first parameter',
'two' => 'This is the second parameter',
%$config,
};
bless $self, $class;
}
#-----------------------------------------------------------------------
# define 'DestructorSingleton' which has a destructor method
#-----------------------------------------------------------------------
package DestructorSingleton;
use base 'Class::Singleton';
sub DESTROY {
main::ok(1, 'destructor called' );
}
#========================================================================
# -- TESTS --
#========================================================================
package main;
# call Class::Singleton->instance() twice and expect to get the same
# reference returned on both occasions.
ok( ! Class::Singleton->has_instance(), 'no Class::Singleton instance yet' );
my $s1 = Class::Singleton->instance();
ok( $s1, 'created Class::Singleton instance 1' );
my $s2 = Class::Singleton->instance();
ok( $s2, 'created Class::Singleton instance 2' );
is( $s1, $s2, 'both instances are the same object' );
is( Class::Singleton->has_instance(), $s1, 'Class::Singleton has instance' );
# call MySingleton->instance() twice and expect to get the same
# reference returned on both occasions.
ok( ! DerivedSingleton->has_instance(), 'no DerivedSingleton instance yet' );
my $s3 = DerivedSingleton->instance();
ok( $s3, 'created DerivedSingleton instance 1' );
my $s4 = DerivedSingleton->instance();
ok( $s4, 'created DerivedSingleton instance 2' );
is( $s3, $s4, 'both derived instances are the same object' );
is( DerivedSingleton->has_instance(), $s3, 'DerivedSingleton has instance' );
# call MyOtherSingleton->instance() twice and expect to get the same
# reference returned on both occasions.
my $s5 = AnotherSingleton->instance( x => 10 );
ok( $s5, 'created AnotherSingleton instance 1' );
is( $s5->x, 10, 'first instance x is 10' );
my $s6 = AnotherSingleton->instance();
ok( $s6, 'created AnotherSingleton instance 2' );
is( $s6->x, 10, 'second instance x is 10' );
is( $s5, $s6, 'both another instances are the same object' );
#------------------------------------------------------------------------
# having checked that each instance of the same class is the same, we now
# check that the instances of the separate classes are actually different
# from each other
#------------------------------------------------------------------------
isnt( $s1, $s3, "Class::Singleton and DerviedSingleton are different");
isnt( $s1, $s5, "Class::Singleton and AnotherSingleton are different");
isnt( $s3, $s5, "DerivedSingleton and AnotherSingleton are different");
#------------------------------------------------------------------------
# test ListSingleton
#------------------------------------------------------------------------
my $ls1 = ListSingleton->instance();
ok( $ls1, 'created ListSingleton instance 1' );
my $ls2 = ListSingleton->instance();
ok( $ls2, 'created ListSingleton instance 2' );
is( $ls1, $ls2, 'both list instances are the same object' );
ok( $ls1 =~ /ARRAY/, "ListSingleton is a list reference");
#------------------------------------------------------------------------
# test ConfigSingleton
#------------------------------------------------------------------------
# create a ConfigSingleton
my $config = { 'foo' => 'This is foo' };
my $cs1 = ConfigSingleton->instance($config);
ok( $cs1, 'created ConfigSingleton instance 1' );
# add another parameter to the config
$config->{'bar'} = 'This is bar';
# shouldn't call new() so changes to $config shouldn't matter
my $cs2 = ConfigSingleton->instance($config);
ok( $cs2, 'created ConfigSingleton instance 2' );
is( $cs1, $cs2, 'both config instances are the same object' );
is( scalar(keys %$cs1), 3, "ConfigSingleton 1 has 3 keys");
is( scalar(keys %$cs2), 3, "ConfigSingleton 2 has 3 keys");
#-----------------------------------------------------------------------
# test DestructorSingleton
#-----------------------------------------------------------------------
my $ds1 = DestructorSingleton->instance();