Выпуск 21. Ноябрь 2014

← От редактора | Содержание | GUI-приложения на Perl с помощью wxWidgets →

Тестирование в Perl. Практика

Следущая статья из цикла «Тестирование в Perl». На этот раз практические рекомендации и примеры

В прошлой статье Тестирование в Perl. Лучшие практики были перечислены особенности юнит-тестирования в Perl, как стоит писать и группировать тесты и т.д. Однако тем, кто не применял тестирование и не сталкивался с проблемами, трудно оценить и хорошие практики. На этот раз постараемся на практических примерах рассмотреть, как же тестировать классы.

В качестве задачи возьмем модуль логирования, который может логировать в stderr и в файл. Модуль должен поддерживать уровни логирования: error, warn и debug, а в качестве формата: <дата> <уровень> <сообщение>.

Начальная структура модуля:

lib/
    Logger.pm
t/
    logger.t

Где lib директория с модулем, а t — директория с тестами.

Изначально модуль выглядит следующим образом:

package Logger;
use strict;
use warnings;

sub new {
    my $class = shift;

    my $self = {};
    bless $self, $class;

    return $self;
}

1;

А тест следующим образом:

use strict;
use warnings;

use Test::More;
use Logger;

subtest 'creates correct object' => sub {
    isa_ok(Logger->new, 'Logger');
};

done_testing;

Запускаем тесты с помощью prove:

$ prove t
t/logger.t .. ok   
All tests successful.

На данный момент все тесты проходят. Но на самом-то деле особо ничего и не тестируется.

Вначале реализуем установку уровней логирования. Например, нам нужно, чтобы по умолчанию уровень был error. Пишем тест:

subtest 'has default log level' => sub {
    my $logger = Logger->new;

    is $logger->level, 'error';
};

Запускаем тесты.

$ prove t
t/logger.t .. 1/? Can't locate object method "level" via package "Logger"

Как видим, у логгера нет такого метода. Добавляем метод:

package Logger;
use strict;
use warnings;

sub new {
    my $class = shift;

    my $self = {};
    bless $self, $class;

    return $self;
}

sub level {
    my $self = shift;

    return 'error';
}

1;

Конечно, мы не хотим, чтобы метод level всегда возвращал одно и тоже значение, нам нужно, чтобы оно как-то сохранялось. Напишем тест, который будет проверять, что устанавливаемое значения сохраняется.

subtest 'sets log level' => sub {
    my $logger = Logger->new;

    $logger->set_level('debug');

    is $logger->level, 'debug';
};

Запускаем тесты:

$ prove t
t/logger.t .. 1/? Can't locate object method "set_level" via package "Logger"

Снова нет нужного метода, добавляем:

sub set_level {
        my $self = shift;
}

Теперь метод есть, но тесты все еще не проходят:

t/logger.t .. 1/?     
    #   Failed test at t/logger.t line 22.
    #          got: 'error'
    #     expected: 'debug'
    # Looks like you failed 1 test of 1.

Теперь метод level возвращает неправильное значение. Самое время реализовать сохранение.


ckage Logger;
use strict;
use warnings;

sub new {
    my $class = shift;

    my $self = {};
    bless $self, $class;

    return $self;
}

sub set_level {
    my $self = shift;
    my ($new_level) = @_;

    $self->{level} = $new_level;
}

sub level {
    my $self = shift;

    return $self->{level};
}

1;

Запускаем тесты:

$ prove
t/logger.t .. 1/?     
    #   Failed test at t/logger.t line 14.
    #          got: undef
    #     expected: 'error'
    # Looks like you failed 1 test of 1.

Хм, кажется, что новый тест начал проходить, но старый перестал. Вот пример того, как в будущем тесты могут выявить ошибку, которая проявится при изменении кода. Конечно, мы забыли, что по умолчанию значение уровня логирования должно быть error. Вернем этот функционал.

sub level {
    my $self = shift;

    return $self->{level} || 'error';
}

Теперь тесты проходят.

Далее необходимо проверить, что можно установить только разрешенные уровни логирования. Если устанавливается неизвестный уровень логирования, будем бросать исключение. Для проверок исключений воспользуемся модулем Test::Fatal. Новый тест будет выглядеть следующим образом:

subtest 'throws exception when invalid log level' => sub {
    my $log = Logger->new;

    ok exception { $log->set_level('unknown') };
};

Также нужно проверить, что все допустимые уровни логирования не бросают исключения. Чтобы не писать несколько одинаковых тестов, просто в цикле проверим каждое значение:

subtest 'not throws when known log level' => sub {
    my $log = Logger->new;

    for my $level (qw/error warn debug/) {
        ok !exception { $log->set_level($level) };
    }
};

Если запустить тесты, то они ожидаемо завалятся:

$ prove t
t/logger.t .. 1/?     
    #   Failed test at t/logger.t line 29.
    # Looks like you failed 1 test of 1.

Но второй тест проходит и без какого либо кода. В данном случае мы знаем, почему так происходит, но часто бывает иначе. Пишется тест, пишется код. Запускается тест и проходит. Программист думает, что все отлично. Но на самом деле его функционал неправильный. Поэтому всегда важно перед написанием кода запустить тест и убедиться, что он не проходит.

Реализуем проверку списка уровней:

package Logger;
use strict;
use warnings;

use Carp qw(croak);
use List::Util qw(first);

sub new {
    my $class = shift;

    my $self = {};
    bless $self, $class;

    return $self;
}

sub set_level {
    my $self = shift;
    my ($new_level) = @_;

    croak('Unknown log level')
      unless first { $new_level eq $_ } qw/error warn debug/;

    $self->{level} = $new_level;
}

sub level {
    my $self = shift;

    return $self->{level} || 'error';
}

1;

В качестве исключений бросается croak из модуля Carp, потому как он логичнее указывает на причину ошибки. Для поиска в списке используется first из модуля List::Util, который в отличие от обычного grep не будет дальше бежать по списку, а остановится при первом совпадении.

Далее напишем тест для метода log. Он должен печатать в stderr. Так как тестирование автоматическое, нужно как-то перехватить это вывод. Воспользуемся модулем Capture::Tiny, который отлично справляется с этой задачей.

use Capture::Tiny qw(capture_stderr);

subtest 'prints to stderr' => sub {
    my $log = Logger->new;

    my $stderr = capture_stderr {
        $log->log('error', 'message');
    };

    ok $stderr;
};

Запускаем тест и убеждаемся, что он не проходит, и реализуем данный функционал:

sub log {
    my $self = shift;
    my ($level, $message) = @_;

    print STDERR $message;
}

Теперь тесты проходят, но, конечно, это не то, что нам нужно, нам нужно получить отформатированный вывод, для этого напишем соответствующий тест:

subtest 'prints formatted line' => sub {
    my $log = Logger->new;

    my $stderr = capture_stderr {
        $log->log('error', 'message');
    };

    like $stderr, qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[error\] message/;
};

Тесты не проходят:

$ prove t
t/logger.t .. 1/?     
    #   Failed test at t/logger.t line 58.
    #                   'message'
    #     doesn't match '(?^:\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[error\] message)'

Для форматирования воспользуемся Time::Piece. Код будет выглядеть следующим образом:

use Time::Piece;

sub log {
    my $self = shift;
    my ($level, $message) = @_;

    my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
    print STDERR $time, " [$level] ", $message;
}

Теперь тесты проходят.

Понятно, что здесь тоже нужно реализовать проверку того, что передается правильный level, но мы переложим эту проверку на компилятор, реализовав отдельные методы для каждого уровня логирования. В итоге мы получим модифицированные тесты:

subtest 'prints to stderr' => sub {
    my $log = Logger->new;

    my $stderr = capture_stderr {
        $log->error('message');
    };

    ok $stderr;
};

subtest 'prints formatted line' => sub {
    my $log = Logger->new;

    my $stderr = capture_stderr {
        $log->error('message');
    };

    like $stderr, qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[error\] message/;
};

Не нужно забывать, что нужно проверить все комбинации, поэтому тесты еще раз модифицируем:

subtest 'prints to stderr' => sub {
    my $log = Logger->new;

    for my $level (qw/error warn debug/) {
        my $stderr = capture_stderr {
            $log->$level('message');
        };

        ok $stderr;
    }
};

subtest 'prints formatted line' => sub {
    my $log = Logger->new;

    for my $level (qw/error warn debug/) {
        my $stderr = capture_stderr {
            $log->$level('message');
        };

        like $stderr, qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d \[$level\] message/;
    }
};

Реализуем подобный фукнционал, спрятав метод log:

sub error { shift->_log('error', @_) }
sub warn  { shift->_log('warn',  @_) }
sub debug { shift->_log('debug', @_) }

sub _log {
    my $self = shift;
    my ($level, $message) = @_;

    my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
    print STDERR $time, " [$level] ", $message;
}

Глядя на код, я заметил ошибку — отсутствие перевода строки. Чтобы убедиться в том, что это ошибка, вначале напишем тест:

subtest 'prints to stderr with \n' => sub {
    my $log = Logger->new;

    for my $level (qw/error warn debug/) {
        my $stderr = capture_stderr {
            $log->$level('message');
        };

        like $stderr, qr/\n$/;
    }
};

Теперь запускаем тесты, чтобы убедиться, что эта ошибка воспроизводится. Теперь исправляем:

print STDERR $time, " [$level] ", $message, "\n";

Если выделять отдельные ошибки в отдельные тесты, в дальнейшем можно легко проверять, что они не возвращаются при исправлении других ошибок или изменении функционала. Это защита от регрессий.

Для чего же вообще реализовывали уровни логирования? Конечно, чтобы при выставленном уровне логировать только те события, уровень которых выше текущего. Т.е. в режиме debug должны логироваться error, warn и debug. В режиме warn — error и warn, а в режиме error только error. Чтобы упростить тесты, составим таблицу ожидаемых значений на тестовые данные. Например, тест на то, что все логируется при нужном уровне, будет выглядеть следующим образом:

subtest 'logs when level is higher' => sub {
    my $log = Logger->new;

    my $levels = {
        error => [qw/error/],
        warn  => [qw/error warn/],
        debug => [qw/error warn debug/],
    };

    for my $level (keys %$levels) {
        $log->set_level($level);
        for my $test_level (@{$levels->{$level}}) {
            ok capture_stderr {
                $log->$test_level('message');
            };
        }
    }
};

Похожим образом будет выглядеть тест, который проверяет, что сообщения не логируются при неправильном уровне:

subtest 'not logs when level is lower' => sub {
    my $log = Logger->new;

    my $levels = {
        error => [qw/warn debug/],
        warn  => [qw/debug/],
    };

    for my $level (keys %$levels) {
        $log->set_level($level);
        for my $test_level (@{$levels->{$level}}) {
            ok !capture_stderr {
                $log->$test_level('message');
            };
        }
    }
};

Здесь нет проверки debug, потому как при этом режиме все логируется. Убеждаемся, что тесты не проходят и пишем реализацию. Во-первых, каждому уровню присваиваем свое значение, во-вторых, перед логированием проверяем, допускает ли текущий уровень логирование.

Во время реализации столкнулся с тем, что при запуске тестов непонятно, что ломается, поэтому добавил сообщения:

ok !capture_stderr {
    $log->$test_level('message');
}, "not log '$test_level' when '$level'";

Теперь сообщения стали понятнее:

    #   Failed test 'not log 'warn' when 'error''
    #   at t/logger.t line 109.

После реализации оказалось, что ломаются многие старые тесты, как, например, вот этот:

subtest 'prints to stderr' => sub {
    my $log = Logger->new;

    for my $level (qw/error warn debug/) {
        my $stderr = capture_stderr {
            $log->$level('message');
        };

        ok $stderr;
    }
};

Понятно, что нужно выставить самый высокий уровень логирования debug. Также и в других тестах.

Измененный код:

my $LEVELS = {
    error => 1,
    warn  => 2,
    debug => 3
};

...

sub set_level {
    my $self = shift;
    my ($new_level) = @_;

    croak('Unknown log level')
      unless first { $new_level eq $_ } keys %$LEVELS;

    $self->{level} = $new_level;
}

sub _log {
    my $self = shift;
    my ($level, $message) = @_;

    return unless $LEVELS->{$level} <= $LEVELS->{$self->level};

    my $time = Time::Piece->new->strftime('%Y-%m-%d %T');
    print STDERR $time, " [$level] ", $message, "\n";
}

Так как создание и инициализация логгера в каждом тесте практически одинаковая, выделим это в отдельный метод и уменьшим дублирование в тесте:

sub _build_logger {
    my $logger = Logger->new;
    $logger->set_level('debug');
    return $logger;
}

На данном этапе логгер полностью протестирован. Чтобы в этом убедиться, запустим Devel::Cover:

$ PERL5OPT=-MDevel::Cover prove t
----------------------------------- ------ ------ ------ ------ ------ ------
File                                  stmt   bran   cond    sub   time  total
----------------------------------- ------ ------ ------ ------ ------ ------
lib/Logger.pm                        100.0  100.0  100.0  100.0    3.4  100.0

Теперь необходимо реализовать логгер, который будет логировать в файл. Чтобы избежать дублирования, в данном случае воспользуемся шаблонными методами, но все зависит от конкретной задачи, и существует большое количество способов. Вначале переименуем логгер в LoggerStderr. Теперь создадим LoggerFile, который будет копией LoggerStderr, также скопируем тест. Теперь директория выглядит следующим образом:

lib/
    LoggerFile.pm
    LoggerStderr.pm
t/
    logger_file.t
    logger_stderr.t

В logger_file.t подправим тесты, которые проверяют, что лог записался в stderr на проверку, что запись была произведена в файл. Вместо Capture::Tiny, напишем собственную функцию, которая будет читать из файла:

sub _slurp {
    my $file = shift;
    return do { local $/; open my $fh, '<', $file or die $!; <$fh> };
}

Для тестирования записи в файл, будет создавать временные файлы с помощью File::Temp, и тесты будут выглядит следущим образом:

subtest 'prints to file' => sub {
    my $file = File::Temp->new;
    my $log = _build_logger(file => $file->filename);

    for my $level (qw/error warn debug/) {
        $log->$level('message');

        my $content = _slurp($file->filename);

        ok $content;
    }
};

Как видно в конструктор передается имя файла и _build_logger приобретает следующий вид:

sub _build_logger {
    my $logger = LoggerFile->new(@_);
    $logger->set_level('debug');
    return $logger;
}

Запускаем тесты и убеждаемся, что они не проходят. Теперь реализовываем запись в файл:

sub _log {
    my $self = shift;
    my ($level, $message) = @_;

    return unless $LEVELS->{$level} <= $LEVELS->{$self->level};

    my $time = Time::Piece->new->strftime('%Y-%m-%d %T');

    open my $fh, '>>', $self->{file} or die $!;
    print $fh $time, " [$level] ", $message, "\n";
    close $fh;
}

И тесты, и реализации содержат много дублирования. Вначале избавимся от дублирования в реализациях, выделив базовый класс с шаблонным методом _print, который будет реализован в LoggerFile и LoggerStderr. Во время рефакторинга постоянно запускаем тесты, чтобы убедиться, что ничего не сломалось.

Базовый класс:

package LoggerBase;
use strict;
use warnings;

use Carp qw(croak);
use List::Util qw(first);
use Time::Piece;

my $LEVELS = {
    error => 1,
    warn  => 2,
    debug => 3
};

sub new {
    my $class = shift;
    my (%params) = @_;

    my $self = {};
    bless $self, $class;

    $self->{file} = $params{file};

    return $self;
}

sub set_level {
    my $self = shift;
    my ($new_level) = @_;

    croak('Unknown log level')
      unless first { $new_level eq $_ } keys %$LEVELS;

    $self->{level} = $new_level;
}

sub level {
    my $self = shift;

    return $self->{level} || 'error';
}

sub error { shift->_log('error', @_) }
sub warn  { shift->_log('warn',  @_) }
sub debug { shift->_log('debug', @_) }

sub _log {
    my $self = shift;
    my ($level, $message) = @_;

    return unless $LEVELS->{$level} <= $LEVELS->{$self->level};

    my $time = Time::Piece->new->strftime('%Y-%m-%d %T');

    my $text = join '', $time, " [$level] ", $message, "\n";

    $self->_print($text);
}

sub _print { ... }

1;

LoggerStderr:

package LoggerStderr;
use strict;
use warnings;

use base 'LoggerBase';

sub _print {
    my $self = shift;
    my ($message) = @_;

    print STDERR $message;
}

1;

LoggerFile:

package LoggerFile;
use strict;
use warnings;

use base 'LoggerBase';

sub new {
    my $self = shift->SUPER::new(@_);
    my (%params) = @_;

    $self->{file} = $params{file};

    return $self;
}

sub _print {
    my $self = shift;
    my ($message) = @_;

    open my $fh, '>>', $self->{file} or die $!;
    print $fh $message;
    close $fh;
}

1;

Так как появился новый класс, его тоже нужно тестировать. Как тестировать базовые классы? В самом тесте создается тестовый класс наследующий тестируемый базовый класс. А из тестов наследников удаляются дублирующие тесты. Некоторые тесты все равно останутся продублированными, но обо всем по порядку. Вначале напишем тест на базовый класс:

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') };
};

sub _build_logger {
    my $logger = LoggerTest->new(@_);
    $logger->set_level('debug');
    return $logger;
}

done_testing;

package LoggerTest;
use base 'LoggerBase';

sub _print { }

Тесты, выделенные в базом тесте, удаляем из других файлов.

На данный момент и в logger_stderr.t, и в logger_file.t остались тесты, которые практически одинаковы, но сильно завязаны на реализацию. Например, в тесте:

subtest 'not logs when level is lower' => sub {
    my $log = _build_logger();

    my $levels = {
        error => [qw/warn debug/],
        warn  => [qw/debug/],
    };

    for my $level (keys %$levels) {
        $log->set_level($level);
        for my $test_level (@{$levels->{$level}}) {
            ok !capture_stderr {
                $log->$test_level('message');
            }, "not log '$test_level' when '$level'";
        }
    }
};

на самом деле нужно проверить, что метод _print не вызывается, а не проверять, была ли запись в stderr. Этот тест можно перенести в базовый, немного модифицировав базовый тестовый класс.

package LoggerTest;
use base 'LoggerBase';

sub new {
    my $self = shift->SUPER::new(@_);
    my (%params) = @_;

    $self->{output} = $params{output};

    return $self;
}

sub _print {
    my $self = shift;

    push @{$self->{output}}, @_;
}

Таким образом, передавая в конструктор массив $output мы сможем дальше в тесте проверить, что в него записалось. Теперь тест на проверку правильности форматировния выглядит следующим образом:

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 \[$level\] message/;
    }
};

и их можно удалить из дочерних классов. Также поступаем с тестами, которые не тестируют саму реализацию записи, а внутреннее поведение, реализованное в базовом классе. Финальные тесты выглядят следущим образом:

logger_base.t:

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 \[$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/],
        debug => [qw/error warn debug/],
    };

    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 'LoggerBase';

sub new {
    my $self = shift->SUPER::new(@_);
    my (%params) = @_;

    $self->{output} = $params{output};

    return $self;
}

sub _print {
    my $self = shift;

    push @{$self->{output}}, @_;
}

logger_stderr.t:

use strict;
use warnings;

use Test::More;
use Test::Fatal;
use Capture::Tiny qw(capture_stderr);
use LoggerStderr;

subtest 'creates correct object' => sub {
    isa_ok(LoggerStderr->new, 'LoggerStderr');
};

subtest 'prints to stderr' => sub {
    my $log = _build_logger();

    for my $level (qw/error warn debug/) {
        my $stderr = capture_stderr {
            $log->$level('message');
        };

        ok $stderr;
    }
};

subtest 'prints to stderr with \n' => sub {
    my $log = _build_logger();

    for my $level (qw/error warn debug/) {
        my $stderr = capture_stderr {
            $log->$level('message');
        };

        like $stderr, qr/\n$/;
    }
};

sub _build_logger {
    my $logger = LoggerStderr->new;
    $logger->set_level('debug');
    return $logger;
}

done_testing;

logger_file.t:

use strict;
use warnings;

use Test::More;
use Test::Fatal;
use File::Temp;
use LoggerFile;

subtest 'creates correct object' => sub {
    isa_ok(LoggerFile->new, 'LoggerFile');
};

subtest 'prints to file' => sub {
    my $file = File::Temp->new;
    my $log = _build_logger(file => $file->filename);

    for my $level (qw/error warn debug/) {
        $log->$level('message');

        my $content = _slurp($file);

        ok $content;
    }
};

subtest 'prints to stderr with \n' => sub {
    my $file = File::Temp->new;
    my $log = _build_logger(file => $file);

    for my $level (qw/error warn debug/) {
        $log->$level('message');

        my $content = _slurp($file);

        like $content, qr/\n$/;
    }
};

sub _slurp {
    my $file = shift;
    my $content = do { local $/; open my $fh, '<', $file->filename or die $!; <$fh> };
    return $content;
}

sub _build_logger {
    my $logger = LoggerFile->new(@_);
    $logger->set_level('debug');
    return $logger;
}

done_testing;

В завершение реализуем фабрику, которая создает тот или иной логгер. Нужно протестировать, что возращается нужный объект, и что при неизвестном запрашиваемом логгере бросается ошибка. Тест может выглядеть следующим образом:

use strict;
use warnings;

use Test::More;
use Test::Fatal;
use Logger;

subtest 'creates stderr logger' => sub {
    my $logger = Logger->build('stderr');

    isa_ok $logger, 'LoggerStderr';
};

subtest 'creates file logger' => sub {
    my $logger = Logger->build('file');

    isa_ok $logger, 'LoggerFile';
};

subtest 'throws when unknown logger' => sub {
    ok exception { Logger->build('unknown') };
};

done_testing;

И сама фабрика:

package Logger;

use strict;
use warnings;

use Carp qw(croak);
use LoggerStderr;
use LoggerFile;

sub build {
    my $class = shift;
    my ($type, @args) = @_;

    if ($type eq 'stderr') {
        return LoggerStderr->new(@args);
    } elsif ($type eq 'file') {
        return LoggerFile->new(@args);
    }

    croak('Unknown type');
}

1;

Таким образом мы написали с помощью TDD-методологии простейший логгер. Надеюсь, что процесс был понятным, а если нет — спрашивайте в комментариях!

■ Вячеслав Тихановский

← От редактора | Содержание | GUI-приложения на Perl с помощью wxWidgets →

Комментарии к статье

© pragmaticperl.com
Все материалы принадлежат их авторам. Перепечатывать статьи без спросу вредно.
По вопросам рекламы и размещения вакансий, пишите на editor эт pragmaticperl дот com.
Работает на Tu и Perl

Pragmatic Perl

Выпуск 21. Ноябрь 2014

Тестирование в Perl. Практика

Комментарии к статье