Quick Start
Minimum prerequisites
Before starting to write the tests in Perl we have to have a perl interpreter. On most unix-derived systems it comes preinstalled. If not, check your OS package manager.
On Windows try installing Strawberry Perl.
It is recommended to install the latest perl available, something in the 20th versions. In addition to the perl the following modules have to be installed: Test2::Suite and Moo. The first one usually comes with modern perls, but some distributions package it separately (look for perl-modules or something like that in your package manager). It is recommended to use your OS package manager for installing the modules. If you cannot do that, take a look at cpanminus. It can be installed locally with the following command:
And then:
Additionally you want to have a text editor for creating and changing the code and the tests. Any editor that you are familiar with would work, but vim is the best one.
Testing a logging module
For those who haven’t used testing and haven’t had any issues it’s hard to recognize the best practices. In this chapter we will try to test classes by using practical examples. This is a quick start for impatient. If you do not understand anything from this chapter, do not worry, we will explain in detail all the techniques later.
As an example we will take a logging modules, which can log to stderr and to a file. The module should support the following log levels: error, warn and debug, and use this output format: <date> <level> <mesage>.
Here is the initial module structure:
Where lib is a module directory, and t is a test directory.
The minimum Perl class looks like this (we use Moo and friends here just for pure simplicity, but you can use any OOP framework of course):
1 package Logger;
2 use Moo;
3
4 1;
And here is our test:
1 use Test2::V0
2 use Logger;
3
4 subtest 'creates correct object' => sub {
5 isa_ok(Logger->new, 'Logger');
6 };
7
8 done_testing;
Let’s run the tests using prove:
At this point all the tests pass. But of course in reality we don’t test anything.
Let’s implement the log level setting feature first. For example, we want the default log level to be error. Let’s
write the test:
1 subtest 'has default log level' => sub {
2 my $logger = Logger->new;
3
4 is $logger->level, 'error';
5 };
And now let’s run it.
As we can see our logging class doesn’t have such method. Let’s add it:
1 package Logger;
2 use Moo;
3
4 sub level {
5 my $self = shift;
6
7 return 'error';
8 }
9
10 1;
Of course we don’t want the method level to always return the same value, we want to save it somehow. We are going to
write a test that will assure that the set value is saved.
1 subtest 'sets log level' => sub {
2 my $logger = Logger->new;
3
4 $logger->set_level('debug');
5
6 is $logger->level, 'debug';
7 };
Run the tests:
Again, not such method. Let’s add it:
1 sub set_level {
2 my $self = shift;
3 }
Now the method exists, but the tests still fail:
Now the method level returns the wrong value. It’s time to implement the saving feature.
1 package Logger;
2 use Moo;
3
4 sub set_level {
5 my $self = shift;
6 my ($new_level) = @_;
7
8 $self->{level} = $new_level;
9 }
10
11 sub level {
12 my $self = shift;
13
14 return $self->{level};
15 }
16
17 1;
Run the tests:
Hm, looks like the new test started to work, but the old one broke. Here is an example how the tests can detect future
issues, that would arrise when we modify the code. Of course in this case we forgot that the default level is error.
Let’s re-add this functionality.
1 sub level {
2 my $self = shift;
3
4 return $self->{level} || 'error';
5 }
Now all the tests pass.
The next thing that we’re going to is to make sure that only the allowed log levels can be set. If we set an unknown log level we should get an exception. The new test will look like this:
1 subtest 'throws exception when invalid log level' => sub {
2 my $log = Logger->new;
3
4 ok dies { $log->set_level('unknown') };
5 };
Also we have to check that all correct log levels do not throw exceptions. In order to not to write a lot of similar test cases, we will check the value in a loop:
1 subtest 'not throws when known log level' => sub {
2 my $log = Logger->new;
3
4 for my $level (qw/error warn debug/) {
5 ok lives { $log->set_level($level) };
6 }
7 };
If we run the tests, they will fail as expected:
But the second test passes without any code. In this case we know why this happens, but in real life everything can be different. We write the test, we write the code. Then we run test and it passes. So a programmer thinks that everything is working fine. But in reality the implementation is wrong. It is always very important to run the test first to make sure it is failing and only then add new code.
Let’s implement the log level list check:
1 package Logger;
2 use Moo;
3
4 use Carp qw(croak);
5 use List::Util qw(first);
6
7 sub set_level {
8 my $self = shift;
9 my ($new_level) = @_;
10
11 croak('Unknown log level')
12 unless first { $new_level eq $_ } qw/error warn debug/;
13
14 $self->{level} = $new_level;
15 }
16
17 sub level {
18 my $self = shift;
19
20 return $self->{level} || 'error';
21 }
22
23 1;
For exceptions we use croak from Carp modules, because it gives a better error message and its source. For list
search we’re using first from List::Util module since compared to default grep it stops after the first match. For
our task that’s irrelevant, but still a good practice in general.
Now we write the test for the log method. It should print to stderr. Since the testing is automatic we have to catch
the output somehow. For this we can use Capture::Tiny module which perfectly does the needed work.
1 use Capture::Tiny qw(capture_stderr);
2
3 subtest 'prints to stderr' => sub {
4 my $log = Logger->new;
5
6 my $stderr = capture_stderr {
7 $log->log('error', 'message');
8 };
9
10 ok $stderr;
11 };
We run the test and see that it doesn’t pass, so we implement the new functionality:
1 sub log {
2 my $self = shift;
3 my ($level, $message) = @_;
4
5 print STDERR $message;
6 }
Now the tests pass, but this is of course not what we want, we want to have a formatted output, so for this we write another test:
1 subtest 'prints formatted line' => sub {
2 my $log = Logger->new;
3
4 my $stderr = capture_stderr {
5 $log->log('error', 'message');
6 };
7
8 like $stderr, qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[error\] message/;
9 };
Now the tests fail:
For date formatting we will use Time::Piece. The code will look like this:
1 use Time::Piece;
2
3 sub log {
4 my $self = shift;
5 my ($level, $message) = @_;
6
7 my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
8 print STDERR $time, " [$level] ", $message;
9 }
Now the tests pass.
Here we would have to implement a check that the correct level value is passed, but we can move this task to the
compiler by adding a separate method for every level. Finally we will have to following tests:
1 subtest 'prints to stderr' => sub {
2 my $log = Logger->new;
3
4 my $stderr = capture_stderr {
5 $log->error('message');
6 };
7
8 ok $stderr;
9 };
10
11 subtest 'prints formatted line' => sub {
12 my $log = Logger->new;
13
14 my $stderr = capture_stderr {
15 $log->error('message');
16 };
17
18 like $stderr, qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[error\] message/;
19 };
We should not forget that we have to check all combinations, so let’s modify the tests again:
1 subtest 'prints to stderr' => sub {
2 my $log = Logger->new;
3
4 for my $level (qw/error warn debug/) {
5 my $stderr = capture_stderr {
6 $log->$level('message');
7 };
8
9 ok $stderr;
10 }
11 };
12
13 subtest 'prints formatted line' => sub {
14 my $log = Logger->new;
15
16 for my $level (qw/error warn debug/) {
17 my $stderr = capture_stderr {
18 $log->$level('message');
19 };
20
21 like $stderr, qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[$level\] message/;
22 }
23 };
Let’s implement the needed feature, hiding the log method:
1 sub error { shift->_log('error', @_) }
2 sub warn { shift->_log('warn', @_) }
3 sub debug { shift->_log('debug', @_) }
4
5 sub _log {
6 my $self = shift;
7 my ($level, $message) = @_;
8
9 my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
10 print STDERR $time, " [$level] ", $message;
11 }
Looking at the code I found an error, we do not have a newline. Let’s check if I am right but writing the following test:
1 subtest 'prints to stderr with \n' => sub {
2 my $log = Logger->new;
3
4 for my $level (qw/error warn debug/) {
5 my $stderr = capture_stderr {
6 $log->$level('message');
7 };
8
9 like $stderr, qr/\n$/;
10 }
11 };
Ok, now we know that there is no newline and that we can reproduce the error. Now let’s fix it:
1 print STDERR $time, " [$level] ", $message, "\n";
If we group the future bugs detected in our good to new test cases, in the future we can easily detect that we do not have any regressions, the bugs do not come to live, when we are fixing other bugs or adding new code. This is our protection.
So why did we implement log levels? Of course to generate output only when the appropriate level is set, which is higher
than the current one. In other words in debug level we should get error, warn and debug messages. At level
warn we should get error and warn, and finally at level error only error. In order to simplify the tests we
will create a table with expected output values when using specific input cases.
For example, the test that checks that we get logging on appropriate level will look like this:
1 subtest 'logs when level is higher' => sub {
2 my $log = Logger->new;
3
4 my $levels = {
5 error => [qw/error/],
6 warn => [qw/error warn/],
7 debug => [qw/error warn debug/],
8 };
9
10 for my $level (keys %$levels) {
11 $log->set_level($level);
12 for my $test_level (@{$levels->{$level}}) {
13 ok capture_stderr {
14 $log->$test_level('message');
15 };
16 }
17 }
18 };
The test that checks that the messages do not appear when the appropriate log level is set will look very similar:
1 subtest 'not logs when level is lower' => sub {
2 my $log = Logger->new;
3
4 my $levels = {
5 error => [qw/warn debug/],
6 warn => [qw/debug/],
7 };
8
9 for my $level (keys %$levels) {
10 $log->set_level($level);
11 for my $test_level (@{$levels->{$level}}) {
12 ok !capture_stderr {
13 $log->$test_level('message');
14 };
15 }
16 }
17 };
Here we do not have the debug level check, since in this mode everything is logged. Now we make sure that our tests
fail and write the needed code. First of all, to every log level we assign its own value, the second, before logging we
check if the level is matched.
When running tests you may find it hard to see what is failing, thus we can add a diagnostic message:
1 ok !capture_stderr {
2 $log->$test_level('message');
3 }, "not log '$test_level' when '$level'";
Now the errors are much clearer:
After adding the new code it looks like many of our old tests start to fail, for example this one:
1 subtest 'prints to stderr' => sub {
2 my $log = Logger->new;
3
4 for my $level (qw/error warn debug/) {
5 my $stderr = capture_stderr {
6 $log->$level('message');
7 };
8
9 ok $stderr;
10 }
11 };
It’s clear that we have to set the highest debug log level in other tests too.
Changed code:
1 my $LEVELS = {
2 error => 1,
3 warn => 2,
4 debug => 3
5 };
6
7 ...
8
9 sub set_level {
10 my $self = shift;
11 my ($new_level) = @_;
12
13 croak('Unknown log level')
14 unless first { $new_level eq $_ } keys %$LEVELS;
15
16 $self->{level} = $new_level;
17 }
18
19 sub _log {
20 my $self = shift;
21 my ($level, $message) = @_;
22
23 return unless $LEVELS->{$level} <= $LEVELS->{$self->level};
24
25 my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
26 print STDERR $time, " [$level] ", $message, "\n";
27 }
Since log creation and initialization in every test looks almost identical, let’s extract it to a separate method, thus lowering the duplicated code.
1 sub _build_logger {
2 my $logger = Logger->new;
3 $logger->set_level('debug');
4 return $logger;
5 }
Now the logger is fully tested. To make sure, let’s run Devel::Cover to see the test coverage:
Now we have to implement the logger which logs into the file. In order to reduce the duplicated code, we can use template methods, but of course it always depends on the task, there are lots of ways to do that.
As a start we rename our logger to LoggerStderr. Then we create LoggerFile, which will be LoggerStderr copy for
now, also we will copy the test. Our directory structure looks like this:
In logger_file.t we change the tests that check that the log message was written into stderr, so they check that the
message was written into a file. Insted of Capture::Tiny, let’s write our own function which will read from the file:
1 sub _slurp {
2 my $file = shift;
3 return do { local $/; open my $fh, '<', $file or die $!; <$fh> };
4 }
For testing that the file was written we’re going to create temporary files with the help of File::Temp and our tests
will look like this:
1 subtest 'prints to file' => sub {
2 my $file = File::Temp->new;
3 my $log = _build_logger(file => $file->filename);
4
5 for my $level (qw/error warn debug/) {
6 $log->$level('message');
7
8 my $content = _slurp($file->filename);
9
10 ok $content;
11 }
12 };
As can be seen we pass the file name into constructor and our _build_logger now looks like this:
1 sub _build_logger {
2 my $logger = LoggerFile->new(@_);
3 $logger->set_level('debug');
4 return $logger;
5 }
We run the test and validate that they fail. Now we implement the file writing.
1 sub _log {
2 my $self = shift;
3 my ($level, $message) = @_;
4
5 return unless $LEVELS->{$level} <= $LEVELS->{$self->level};
6
7 my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
8
9 open my $fh, '>>', $self->{file} or die $!;
10 print $fh $time, " [$level] ", $message, "\n";
11 close $fh;
12 }
Now the tests and implementation both have a lot of duplicated code. First, let’s get rid of it in implementation,
extracting the base class with a template method _print, which will be implemented in LoggerFile and LoggerStderr.
During the refactoring we should run the tests as often as possible, to make sure that nothing has been broken.
The base class:
1 package LoggerBase;
2 use Moo;
3
4 use Carp qw(croak);
5 use List::Util qw(first);
6 use Time::Piece;
7
8 my $LEVELS = {
9 error => 1,
10 warn => 2,
11 debug => 3
12 };
13
14 sub set_level {
15 my $self = shift;
16 my ($new_level) = @_;
17
18 croak('Unknown log level')
19 unless first { $new_level eq $_ } keys %$LEVELS;
20
21 $self->{level} = $new_level;
22 }
23
24 sub level {
25 my $self = shift;
26
27 return $self->{level} || 'error';
28 }
29
30 sub error { shift->_log('error', @_) }
31 sub warn { shift->_log('warn', @_) }
32 sub debug { shift->_log('debug', @_) }
33
34 sub _log {
35 my $self = shift;
36 my ($level, $message) = @_;
37
38 return unless $LEVELS->{$level} <= $LEVELS->{$self->level};
39
40 my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
41
42 my $text = join '', $time, " [$level] ", $message, "\n";
43
44 $self->_print($text);
45 }
46
47 sub _print { ... }
48
49 1;
LoggerStderr:
1 package LoggerStderr;
2 use strict;
3 use warnings;
4
5 use base 'LoggerBase';
6
7 sub _print {
8 my $self = shift;
9 my ($message) = @_;
10
11 print STDERR $message;
12 }
13
14 1;
LoggerFile:
1 package LoggerFile;
2 use Moo;
3 BEGIN { extends 'LoggerBase' }
4
5 sub BUILD {
6 my $self = shift;
7 my (%params) = @_;
8
9 $self->{file} = $params{file};
10
11 return $self;
12 }
13
14 sub _print {
15 my $self = shift;
16 my ($message) = @_;
17
18 open my $fh, '>>', $self->{file} or die $!;
19 print $fh $message;
20 close $fh;
21 }
22
23 1;
Since now we have created a new class, we have to test it also. How do we test base classes? A common way to do that is to create a fake test class that will inherit from the testable one. And then we remove from the test everything that is duplicated. Some of the tests will remain duplicated, but let’s do it step by step.
Let’s implement the base class test:
1 use Test2::V0
2
3 subtest 'creates correct object' => sub {
4 isa_ok(LoggerTest->new, 'LoggerTest');
5 };
6
7 subtest 'has default log level' => sub {
8 my $logger = LoggerTest->new;
9
10 is $logger->level, 'error';
11 };
12
13 subtest 'sets log level' => sub {
14 my $logger = LoggerTest->new;
15
16 $logger->set_level('debug');
17
18 is $logger->level, 'debug';
19 };
20
21 subtest 'not throws when known log level' => sub {
22 my $log = LoggerTest->new;
23
24 for my $level (qw/error warn debug/) {
25 ok lives { $log->set_level($level) };
26 }
27 };
28
29 subtest 'throws exception when invalid log level' => sub {
30 my $log = LoggerTest->new;
31
32 ok dies { $log->set_level('unknown') };
33 };
34
35 sub _build_logger {
36 my $logger = LoggerTest->new(@_);
37 $logger->set_level('debug');
38 return $logger;
39 }
40
41 done_testing;
42
43 package LoggerTest;
44 use base 'LoggerBase';
45
46 sub _print { }
Now we remove the base class tests from other files.
The files logger_stderr.t and logger_file.t have tests that are almost identical, but they are closely coupled with
the implementation, for example in this test:
1 subtest 'not logs when level is lower' => sub {
2 my $log = _build_logger();
3
4 my $levels = {
5 error => [qw/warn debug/],
6 warn => [qw/debug/],
7 };
8
9 for my $level (keys %$levels) {
10 $log->set_level($level);
11 for my $test_level (@{$levels->{$level}}) {
12 ok !capture_stderr {
13 $log->$test_level('message');
14 }, "not log '$test_level' when '$level'";
15 }
16 }
17 };
actually here we have to check that _print method is not called, and not that there is a message in stderr. We can
move this test into the base one, but before we have to change the base class a little:
1 package LoggerTest;
2 use Moo;
3 BEGIN { extends 'LoggerBase' }
4
5 sub BUILD {
6 my $self = shift;
7 my (%params) = @_;
8
9 $self->{output} = $params{output};
10
11 return $self;
12 }
13
14 sub _print {
15 my $self = shift;
16
17 push @{$self->{output}}, @_;
18 }
This way by passing $output we can later on in the test check that something was written there. Now the test that
check the correctness of formatting can look like this:
1 subtest 'prints formatted line' => sub {
2 my $output = [];
3 my $log = _build_logger(output => $output);
4
5 for my $level (qw/error warn debug/) {
6 $log->$level('message');
7
8 like $output->[-1], qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[$level\] message/;
9 }
10 };
and we can remove that from the child classes. The same thing we perform with the tests that do not check the writing implementation, but check the internal behaviour, implemented in the base class. Final tests look like this:
logger_base.t:
1 use Test2::V0
2
3 subtest 'creates correct object' => sub {
4 isa_ok(LoggerTest->new, 'LoggerTest');
5 };
6
7 subtest 'has default log level' => sub {
8 my $logger = LoggerTest->new;
9
10 is $logger->level, 'error';
11 };
12
13 subtest 'sets log level' => sub {
14 my $logger = LoggerTest->new;
15
16 $logger->set_level('debug');
17
18 is $logger->level, 'debug';
19 };
20
21 subtest 'not throws when known log level' => sub {
22 my $log = LoggerTest->new;
23
24 for my $level (qw/error warn debug/) {
25 ok lives { $log->set_level($level) };
26 }
27 };
28
29 subtest 'throws exception when invalid log level' => sub {
30 my $log = LoggerTest->new;
31
32 ok dies { $log->set_level('unknown') };
33 };
34
35 subtest 'prints formatted line' => sub {
36 my $output = [];
37 my $log = _build_logger(output => $output);
38
39 for my $level (qw/error warn debug/) {
40 $log->$level('message');
41
42 like $output->[-1],
43 qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[$level\] message/;
44 }
45 };
46
47 subtest 'logs when level is higher' => sub {
48 my $output = [];
49 my $log = _build_logger(output => $output);
50
51 my $levels = {
52 error => [qw/error/],
53 warn => [qw/error warn/],
54 debug => [qw/error warn debug/],
55 };
56
57 for my $level (keys %$levels) {
58 $log->set_level($level);
59 for my $test_level (@{$levels->{$level}}) {
60 $log->$test_level('message');
61
62 ok $output->[-1];
63 }
64 }
65 };
66
67 subtest 'not logs when level is lower' => sub {
68 my $output = [];
69 my $log = _build_logger(output => $output);
70
71 my $levels = {
72 error => [qw/warn debug/],
73 warn => [qw/debug/],
74 };
75
76 for my $level (keys %$levels) {
77 $log->set_level($level);
78 for my $test_level (@{$levels->{$level}}) {
79 $log->$test_level('message');
80
81 ok !$output->[-1], "not log '$test_level' when '$level'";
82 }
83 }
84 };
85
86 sub _build_logger {
87 my $logger = LoggerTest->new(@_);
88 $logger->set_level('debug');
89 return $logger;
90 }
91
92 done_testing;
93
94 package LoggerTest;
95 use Moo;
96 BEGIN { extends 'LoggerBase' }
97
98 sub BUILD {
99 my $self = shift;
100 my (%params) = @_;
101
102 $self->{output} = $params{output};
103
104 return $self;
105 }
106
107 sub _print {
108 my $self = shift;
109
110 push @{$self->{output}}, @_;
111 }
logger_stderr.t:
1 use Test2::V0
2 use Capture::Tiny qw(capture_stderr);
3 use LoggerStderr;
4
5 subtest 'creates correct object' => sub {
6 isa_ok(LoggerStderr->new, 'LoggerStderr');
7 };
8
9 subtest 'prints to stderr' => sub {
10 my $log = _build_logger();
11
12 for my $level (qw/error warn debug/) {
13 my $stderr = capture_stderr {
14 $log->$level('message');
15 };
16
17 ok $stderr;
18 }
19 };
20
21 subtest 'prints to stderr with \n' => sub {
22 my $log = _build_logger();
23
24 for my $level (qw/error warn debug/) {
25 my $stderr = capture_stderr {
26 $log->$level('message');
27 };
28
29 like $stderr, qr/\n$/;
30 }
31 };
32
33 sub _build_logger {
34 my $logger = LoggerStderr->new;
35 $logger->set_level('debug');
36 return $logger;
37 }
38
39 done_testing;
logger_file.t:
1 use Test2::V0
2 use File::Temp;
3 use LoggerFile;
4
5 subtest 'creates correct object' => sub {
6 isa_ok(LoggerFile->new, 'LoggerFile');
7 };
8
9 subtest 'prints to file' => sub {
10 my $file = File::Temp->new;
11 my $log = _build_logger(file => $file->filename);
12
13 for my $level (qw/error warn debug/) {
14 $log->$level('message');
15
16 my $content = _slurp($file);
17
18 ok $content;
19 }
20 };
21
22 subtest 'prints to stderr with \n' => sub {
23 my $file = File::Temp->new;
24 my $log = _build_logger(file => $file);
25
26 for my $level (qw/error warn debug/) {
27 $log->$level('message');
28
29 my $content = _slurp($file);
30
31 like $content, qr/\n$/;
32 }
33 };
34
35 sub _slurp {
36 my $file = shift;
37 my $content = do { local $/; open my $fh, '<', $file->filename or die $!; <$fh> \
38 };
39 return $content;
40 }
41
42 sub _build_logger {
43 my $logger = LoggerFile->new(@_);
44 $logger->set_level('debug');
45 return $logger;
46 }
47
48 done_testing;
As a final touch let’s implement a factory that will create a needed logger. We have to test that the correct object is returned and that if we pass an unknown type we get an exception. The test can look like this:
1 use Test2::V0
2 use Logger;
3
4 subtest 'creates stderr logger' => sub {
5 my $logger = Logger->build('stderr');
6
7 isa_ok $logger, 'LoggerStderr';
8 };
9
10 subtest 'creates file logger' => sub {
11 my $logger = Logger->build('file');
12
13 isa_ok $logger, 'LoggerFile';
14 };
15
16 subtest 'throws when unknown logger' => sub {
17 ok dies { Logger->build('unknown') };
18 };
19
20 done_testing;
And the factory itself:
1 package Logger;
2
3 use strict;
4 use warnings;
5
6 use Carp qw(croak);
7 use LoggerStderr;
8 use LoggerFile;
9
10 sub build {
11 my $class = shift;
12 my ($type, @args) = @_;
13
14 if ($type eq 'stderr') {
15 return LoggerStderr->new(@args);
16 } elsif ($type eq 'file') {
17 return LoggerFile->new(@args);
18 }
19
20 croak('Unknown type');
21 }
22
23 1;
We have implemented a simple logger using TDD methodology.