70 lines
1.8 KiB
Perl
70 lines
1.8 KiB
Perl
use strict;
|
|
use warnings;
|
|
|
|
use Test::More;
|
|
|
|
use lib 'lib'; # test lib/Qpsmtpd (vs site_perl)
|
|
use lib 't';
|
|
|
|
use_ok('Qpsmtpd::DB');
|
|
use_ok('Qpsmtpd');
|
|
|
|
__new();
|
|
__lock();
|
|
__unlock();
|
|
__name();
|
|
|
|
done_testing();
|
|
|
|
sub __new {
|
|
@Qpsmtpd::DB::child_classes = qw(
|
|
BrokenClassOne
|
|
BrokenClassTwo
|
|
);
|
|
my $db;
|
|
eval { $db = Qpsmtpd::DB->new };
|
|
is( $@, "Couldn't load any storage modules\n"
|
|
. "Couldn't load BrokenClassOne: fool me once, shame on me\n\n"
|
|
. "Couldn't load BrokenClassTwo: fool me can't get fooled again\n",
|
|
'Detect failure to load all child DB classes' );
|
|
eval { $db = Qpsmtpd::DB->new( class => 'BrokenClassOne' ) };
|
|
is( $@, "Couldn't load any storage modules\n"
|
|
. "Couldn't load BrokenClassOne: fool me once, shame on me\n",
|
|
'Failure to load manual class' );
|
|
@Qpsmtpd::DB::child_classes = qw( EmptyClass );
|
|
eval { $db = Qpsmtpd::DB->new };
|
|
is( ref $db, 'EmptyClass',
|
|
'Load object with manual (bogus) class: Qpsmtpd object is returned' );
|
|
}
|
|
|
|
sub __lock {
|
|
@Qpsmtpd::DB::child_classes = qw( EmptyClass );
|
|
is( Qpsmtpd::DB->new->lock, 1, 'Default lock() method just returns true' );
|
|
}
|
|
|
|
sub __unlock {
|
|
@Qpsmtpd::DB::child_classes = qw( EmptyClass );
|
|
is( Qpsmtpd::DB->new->unlock, 1, 'Default lock() method just returns true' );
|
|
}
|
|
|
|
sub __name {
|
|
@Qpsmtpd::DB::child_classes = qw( EmptyClass );
|
|
my $db = Qpsmtpd::DB->new;
|
|
is( $db->name, undef, 'no name set yet' );
|
|
is( $db->name('test'), 'test', 'set name' );
|
|
is( $db->name, 'test', 'get name' );
|
|
}
|
|
|
|
package BrokenClassOne;
|
|
sub new { die "fool me once, shame on me\n" }
|
|
|
|
package BrokenClassTwo;
|
|
sub new { die "fool me can't get fooled again\n" }
|
|
|
|
package EmptyClass;
|
|
use parent 'Qpsmtpd::DB';
|
|
sub new {
|
|
my $class = shift;
|
|
return bless {@_}, $class;
|
|
}
|