Log-Mini/t/02_Logger.t

118 lines
2.4 KiB
Perl
Raw Normal View History

2019-02-21 22:30:49 +03:00
use lib 'lib';
use strict;
use warnings;
use Test::More;
use Test::Fatal;
subtest 'creates correct object' => sub {
isa_ok(LoggerTest->new, 'LoggerTest');
};
subtest 'has default log level' => sub {
my $logger = LoggerTest->new;
is $logger->level, 'error';
};
subtest 'sets log level' => sub {
my $logger = LoggerTest->new;
$logger->set_level('debug');
is $logger->level, 'debug';
};
subtest 'not throws when known log level' => sub {
my $log = LoggerTest->new;
for my $level (qw/error warn debug/) {
ok !exception { $log->set_level($level) };
}
};
subtest 'throws exception when invalid log level' => sub {
my $log = LoggerTest->new;
ok exception { $log->set_level('unknown') };
};
subtest 'prints formatted line' => sub {
my $output = [];
my $log = _build_logger(output => $output);
for my $level (qw/error warn debug/) {
$log->$level('message');
like $output->[-1],
qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d.\d{3} \[$level\] message/;
}
};
subtest 'logs when level is higher' => sub {
my $output = [];
my $log = _build_logger(output => $output);
my $levels = {
error => [qw/error/],
warn => [qw/error warn/],
info => [qw/error warn info/],
debug => [qw/error warn info debug/],
trace => [qw/error warn info debug trace/],
};
for my $level (keys %$levels) {
$log->set_level($level);
for my $test_level (@{$levels->{$level}}) {
$log->$test_level('message');
ok $output->[-1];
}
}
};
subtest 'not logs when level is lower' => sub {
my $output = [];
my $log = _build_logger(output => $output);
my $levels = {
error => [qw/warn debug/],
warn => [qw/debug/],
};
for my $level (keys %$levels) {
$log->set_level($level);
for my $test_level (@{$levels->{$level}}) {
$log->$test_level('message');
ok !$output->[-1], "not log '$test_level' when '$level'";
}
}
};
sub _build_logger {
my $logger = LoggerTest->new(@_);
$logger->set_level('debug');
return $logger;
}
done_testing;
package LoggerTest;
use base 'Log::Mini::LoggerBase';
sub new {
my $self = shift->SUPER::new(@_);
my (%params) = @_;
$self->{output} = $params{output};
return $self;
}
sub _print {
my $self = shift;
push @{$self->{output}}, @_;
}