BEGIN {
$| = 1;
print "1..22\n";
}
END {
print "not ok 1\n" unless $loaded;
}
use Class::Singleton;
$loaded = 1;
print "ok 1\n";
$^W = 1;
sub ok {
return join('', @_ ? (" ", @_, "\n") : (), "ok ", ++$loaded, "\n");
}
sub not_ok {
return join('', @_ ? (" ", @_, "\n") : (), "not ok ", ++$loaded, "\n");
}
package DerivedSingleton;
use base 'Class::Singleton';
package AnotherSingleton;
use base 'DerivedSingleton';
package ListSingleton;
use base 'Class::Singleton';
sub _new_instance {
my $class = shift;
bless [], $class;
}
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;
}
package main;
my $s1 = Class::Singleton->instance();
print " Class::Singleton instance 1: ",
defined($s1) ? ok($s1) : not_ok('<undef>');
my $s2 = Class::Singleton->instance();
print " Class::Singleton instance 2: ",
(defined($s2) ? ok($s2) : not_ok('<undef>'));
print $s1 == $s2
? ok('Class::Singleton instances are identical')
: not_ok('Class::Singleton instances are unique');
my $s3 = DerivedSingleton->instance();
print " DerivedSingleton instance 1: ",
defined($s3) ? ok($s3) : not_ok('<undef>');
my $s4 = DerivedSingleton->instance();
print " DerivedSingleton instance 2: ",
defined($s4) ? ok($s4) : not_ok('<undef>');
print $s3 == $s4
? ok("DerivedSingleton instances are identical")
: not_ok("DerivedSingleton instances are unique");
my $s5 = AnotherSingleton->instance();
print " AnotherSingleton instance 1: ",
defined($s5) ? ok($s5) : not_ok('<undef>');
my $s6 = AnotherSingleton->instance();
print " AnotherSingleton instance 2: ",
defined($s6) ? ok($s6) : not_ok('<undef>');
print $s5 == $s6
? ok("AnotherSingleton instances are identical")
: not_ok("AnotherSingleton instances are unique");
print $s1 != $s3
? ok("Class::Singleton and DerviedSingleton are different")
: not_ok("Class::Singleton and DerivedSingleton are identical");
print $s1 != $s5
? ok("Class::Singleton and AnotherSingleton are different")
: not_ok("Class::Singleton and AnotherSingleton are identical");
print $s3 != $s5
? ok("DerivedSingleton and AnotherSingleton are different")
: not_ok("DerivedSingleton and AnotherSingleton are identical");
my $ls1 = ListSingleton->instance();
my $ls2 = ListSingleton->instance();
print $ls1
? ok("ListSingleton #1 is defined")
: not_ok("ListSingleton #1 is not defined");
print $ls2
? ok("ListSingleton #2 is defined")
: not_ok("ListSingleton #2 is not defined");
print $ls1 == $ls2
? ok("ListSingleton #1 and #2 correctly reference the same list")
: not_ok("ListSingleton #1 and #2 so not reference the same list");
print $ls1 =~ /=ARRAY/
? ok("ListSingleton correctly contains a list reference")
: not_ok("ListSingleton does not contain a list reference");
my $config = { 'foo' => 'This is foo' };
my $cs1 = ConfigSingleton->instance($config);
$config->{'bar'} => 'This is bar';
my $cs2 = ConfigSingleton->instance($config);
print $cs1
? ok("ConfigSingleton #1 is defined")
: not_ok("ConfigSingleton #1 is not defined");
print $cs2
? ok("ConfigSingleton #2 is defined")
: not_ok("ConfigSingleton #2 is not defined");
print $cs1 == $cs2
? ok("ConfigSingleton #1 and #2 correctly reference the same object")
: not_ok("ConfigSingleton #1 and #2 so not reference the same object");
print scalar(keys %$cs1) == 3
? ok("ConfigSingleton #1 correctly has 3 keys")
: not_ok("ConfigSingleton #1 does not have 3 keys");
print scalar(keys %$cs2) == 3
? ok("ConfigSingleton #2 correctly has 3 keys")
: not_ok("ConfigSingleton #2 does not have 3 keys");