pur*_*kle 11 testing tdd perl mojolicious
我们创建了以下简单的Mojolicious控制器:
package SampleApp::Pages;
# $Id$
use strict;
use warnings;
our $VERSION = '0.01';
use Mojo::Base 'Mojolicious::Controller';
sub home {
my $self = shift;
$self->render( 'title' => 'Home' );
return;
}
sub contact {
my $self = shift;
$self->render( 'title' => 'Contact' );
return;
}
sub about {
my $self = shift;
$self->render( 'title' => 'About' );
return;
}
1;
Run Code Online (Sandbox Code Playgroud)
相应的单元测试如下:
package Test::SampleApp::Pages;
# $Id$
use strict;
use warnings;
our $VERSION = '0.01';
use Carp;
use English '-no_match_vars';
use Readonly;
use Test::Mojo;
use Test::Most;
use base 'Test::Class';
Readonly my $SERVER_OK => 200;
sub startup : Tests(startup) {
eval {
require SampleApp;
SampleApp->import;
1;
} or Carp::croak($EVAL_ERROR);
return;
}
sub get_home : Tests(4) {
my $test = shift;
my $mojo = $test->mojo;
$mojo->get_ok('/pages/home')->status_is($SERVER_OK);
$mojo->text_is(
'title',
$test->base_title . ' | Home',
'... and should have the right title'
);
$mojo->content_like(
qr/<body>(?:\s*\S+\s*)+<\/body>/msx,
'... and should have a non-blank body'
);
return;
}
sub get_contact : Tests(3) {
my $test = shift;
my $mojo = $test->mojo;
$mojo->get_ok('/pages/contact')->status_is($SERVER_OK);
$mojo->text_is(
'title',
$test->base_title . ' | Contact',
'... and should have the right title'
);
return;
}
sub get_about : Tests(3) {
my $test = shift;
my $mojo = $test->mojo;
$mojo->get_ok('/pages/about')->status_is($SERVER_OK);
$mojo->text_is(
'title',
$test->base_title . ' | About',
'... and should have the right title'
);
return;
}
sub base_title {
my ( $self, $base_title ) = @_;
if ( defined $base_title ) {
$self->{base_title} = $base_title;
}
return $self->{base_title};
}
sub mojo {
my ( $self, $mojo ) = @_;
if ( defined $mojo ) {
$self->{mojo} = $mojo;
}
return $self->{mojo};
}
sub setup : Tests(setup) {
my $test = shift;
$test->base_title('Mojolicious Sample App');
$test->mojo( Test::Mojo->new( app => 'SampleApp', max_redirects => 1 ) );
return;
}
1;
Run Code Online (Sandbox Code Playgroud)
对我们来说,这更像是功能测试而不是单元测试
有没有办法调用home控制器的方法并测试其输出,不需要通过启动服务器实例Test::Mojo?
Gre*_*con 21
要测试控制器的接线,请使用以下代码.
我们从t/pages.t熟悉的前面事件开始.
use Mojolicious;
use Test::More;
Run Code Online (Sandbox Code Playgroud)
现在创建一个SampleApp::Pages记录调用的测试子类render.
package TestingPages;
use Mojo::Base 'SampleApp::Pages';
has 'render_called';
has 'render_arg';
sub render {
my($self,%arg) = @_;
$self->render_called(1);
$self->render_arg({ %arg });
}
Run Code Online (Sandbox Code Playgroud)
使用了您的问题Test::Class,请继续使用该主题.
package Test::SampleApp::Pages;
use base 'Test::Class';
use Test::More;
Run Code Online (Sandbox Code Playgroud)
请注意,die没有参数会传播最新的异常,因此您不必$@显式编写.
sub startup : Test(startup) {
eval { require SampleApp::Pages; SampleApp::Pages->import; 1 } or die;
}
Run Code Online (Sandbox Code Playgroud)
在setup,实例化测试子类,将其连接到Mojolicious实例,并关闭日志记录.
sub setup : Test(setup) {
my($self) = @_;
my $c = TestingPages->new(app => Mojolicious->new);
$c->app->log->path(undef);
$c->app->log->level('fatal');
$self->{controller} = $c;
}
Run Code Online (Sandbox Code Playgroud)
在主测试中,调用控制器的home方法并检查结果.
sub home : Tests(2) {
my($self) = @_;
my $c = $self->{controller};
$c->home;
is $c->render_called, 1, "render called";
is $c->render_arg->{title}, "Home", "correct title arg";
}
Run Code Online (Sandbox Code Playgroud)
最后,运行您的测试.
package main;
Test::SampleApp::Pages->runtests;
Run Code Online (Sandbox Code Playgroud)
输出:
$ ./sampleapp.pl test Running tests from '/tmp/sampleapp/t'. t/pages.t .. ok All tests successful. Files=1, Tests=2, 1 wallclock secs ( 0.03 usr 0.02 sys + 0.24 cusr 0.03 csys = 0.32 CPU) Result: PASS
现在您已经看到了如何做到这一点,问题是它是否值得所有麻烦.控制器应该是简单的接线.考虑控制器中的任何复杂性是否真的属于测试更直接的模型.
| 归档时间: |
|
| 查看次数: |
2905 次 |
| 最近记录: |