Perl 完全指南 / 第 18 章:测试
第 18 章:测试
“没有测试的代码是不可信的”
Perl 是最早拥抱自动化测试的语言之一。TAP(Test Anything Protocol)协议就诞生于 Perl 社区。
18.1 TAP — Test Anything Protocol
TAP 输出格式:
1..4
ok 1 - 加法测试
ok 2 - 减法测试
not ok 3 - 乘法测试
# 失败原因:期望 6,实际 8
ok 4 - 除法测试
| 行 | 含义 |
|---|
1..N | 计划运行 N 个测试 |
ok N | 第 N 个测试通过 |
not ok N | 第 N 个测试失败 |
# | 注释/诊断信息 |
18.2 Test::More — 基础测试
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 7;
# 基本断言
ok(1, "真值测试");
ok(!0, "假值测试");
# 相等性
is(2 + 2, 4, "加法");
isnt(2 + 2, 5, "不相等");
# 比较
cmp_ok(5, '>', 3, "大于比较");
cmp_ok("abc", 'eq', "abc", "字符串相等");
# 正则匹配
like("Hello World", qr/World/, "正则匹配");
unlike("Hello World", qr/Perl/, "正则不匹配");
常用测试函数
| 函数 | 说明 |
|---|
ok($test, $name) | 真值测试 |
is($got, $expected) | 相等测试 |
isnt($got, $unexpected) | 不相等测试 |
like($str, qr/.../) | 正则匹配 |
unlike($str, qr/.../) | 正则不匹配 |
cmp_ok($got, $op, $expected) | 比较运算符测试 |
is_deeply($got, $expected) | 深度比较 |
isa_ok($obj, $class) | 类型检查 |
can_ok($obj, @methods) | 方法存在检查 |
pass($name) | 无条件通过 |
fail($name) | 无条件失败 |
skip($reason, $count) | 跳过测试 |
todo { ... } $reason | 标记为 TODO |
done_testing
# 不指定测试数量
use Test::More;
ok(1, "test 1");
ok(1, "test 2");
ok(1, "test 3");
done_testing(); # 结束测试
18.3 测试文件组织
测试文件命名
t/
├── 00-load.t # 加载测试
├── 01-basic.t # 基础功能
├── 02-functions.t # 函数测试
├── 03-integration.t # 集成测试
├── author/
│ └── pod.t # 作者测试(POD 格式)
├── release/
│ └── critic.t # 代码质量
└── lib/
└── TestHelper.pm # 测试辅助模块
模板
#!/usr/bin/env perl
# t/00-load.t
use strict;
use warnings;
use Test::More;
# 测试模块能否加载
use_ok('MyApp::Utils');
# 测试版本号
my $version = MyApp::Utils->VERSION;
ok($version, "版本号存在: $version");
done_testing();
18.4 高级测试技巧
子测试(subtest)
use Test::More;
subtest "用户验证" => sub {
ok(validate_user("admin"), "有效用户");
ok(!validate_user(""), "空用户无效");
ok(!validate_user(undef), "未定义用户无效");
};
subtest "权限检查" => sub {
ok(has_permission("admin", "read"), "读权限");
ok(has_permission("admin", "write"), "写权限");
ok(!has_permission("guest", "admin"), "无管理员权限");
};
done_testing();
测试异常
use Test::More;
use Test::Exception;
# 测试 die
throws_ok { divide(10, 0) } qr/division by zero/, "除零异常";
# 测试不 die
lives_ok { divide(10, 2) } "正常除法不死";
done_testing();
测试数据库
use Test::More;
use Test::DBIx::Class;
# 自动创建内存数据库
fixtures_ok [
User => [
[qw/name email age/],
["张三", "zhangsan\@example.com", 30],
["李四", "lisi\@example.com", 25],
],
], "安装测试数据";
# 测试查询
my $users = ResultSet('User')->search({age => {'>=' => 25}});
is($users->count, 2, "找到 2 个 25 岁以上的用户");
done_testing();
18.5 Test::Mojo — Web 应用测试
#!/usr/bin/env perl
use Test::More;
use Test::Mojo;
use Mojolicious::Lite;
# 定义应用
get '/api/users' => sub ($c) {
$c->render(json => {users => [{name => "张三"}]});
};
post '/api/users' => sub ($c) {
my $data = $c->req->json;
return $c->render(json => {error => "name required"}, status => 400)
unless $data->{name};
$c->render(json => {id => 1, name => $data->{name}}, status => 201);
};
# 测试
my $t = Test::Mojo->new;
# GET 测试
$t->get_ok('/api/users')
->status_is(200)
->json_has('/users/0/name')
->json_is('/users/0/name', '张三');
# POST 测试
$t->post_ok('/api/users' => json => {name => '李四'})
->status_is(201)
->json_is('/id', 1)
->json_is('/name', '李四');
# 错误测试
$t->post_ok('/api/users' => json => {})
->status_is(400)
->json_has('/error');
done_testing();
Test::Mojo 常用方法
| 方法 | 说明 |
|---|
get_ok($url) | 发起 GET 请求 |
post_ok($url, $json) | 发起 POST 请求 |
put_ok(...) | PUT 请求 |
delete_ok(...) | DELETE 请求 |
status_is($code) | 断言状态码 |
json_is($pointer, $value) | 断言 JSON 值 |
json_has($pointer) | 断言 JSON 字段存在 |
json_like($pointer, $re) | JSON 正则匹配 |
content_like(qr/.../) | 内容正则匹配 |
header_is($name, $value) | 断言响应头 |
content_type_is($type) | 断言 Content-Type |
18.6 运行测试
# 运行所有测试
prove -l t/
# 详细输出
prove -lv t/
# 并行运行
prove -j4 -l t/
# 运行单个测试文件
perl -Ilib t/01-basic.t
# 使用 TAP::Formatter::HTML 生成 HTML 报告
prove --formatter TAP::Formatter::HTML -l t/ > report.html
# 只运行失败的测试
prove -l t/ --state=failed
18.7 Test::Deep — 深度比较
use Test::More;
use Test::Deep;
my $data = {
users => [
{ name => "张三", age => 30 },
{ name => "李四", age => 25 },
],
count => 2,
};
cmp_deeply($data, {
users => array_each({
name => re(qr/^[\x{4e00}-\x{9fff}]+$/), # 汉字
age => num(25, 10), # 25±10
}),
count => 2,
}, "数据结构匹配");
# 忽略特定字段
cmp_deeply($data, superhashof({
count => 2,
}), "count 为 2");
18.8 业务场景:API 测试套件
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Mojo;
use FindBin;
use lib "$FindBin::Bin/../lib";
require "$FindBin::Bin/../script/myapp";
my $t = Test::Mojo->new;
# 认证
subtest "认证" => sub {
$t->post_ok('/api/login' => json => {
username => 'admin',
password => 'password',
})->status_is(200)
->json_has('/token');
my $token = $t->tx->res->json('/token');
$t->ua->on(start => sub ($ua, $tx) {
$tx->req->headers->authorization("Bearer $token");
});
};
# 用户 CRUD
subtest "用户 CRUD" => sub {
# 创建
$t->post_ok('/api/users' => json => {
name => "测试用户", email => "test\@example.com"
})->status_is(201)->json_has('/id');
my $id = $t->tx->res->json('/id');
# 查询
$t->get_ok("/api/users/$id")
->status_is(200)
->json_is('/name', '测试用户');
# 更新
$t->put_ok("/api/users/$id" => json => {name => "已更新"})
->status_is(200)
->json_is('/name', '已更新');
# 删除
$t->delete_ok("/api/users/$id")
->status_is(200);
# 确认已删除
$t->get_ok("/api/users/$id")
->status_is(404);
};
done_testing();
本章小结
| 要点 | 内容 |
|---|
| TAP | Test Anything Protocol,测试输出标准 |
| Test::More | 基础测试模块 |
| Test::Mojo | Web 应用测试 |
| Test::Deep | 复杂数据结构比较 |
| Test::Exception | 异常测试 |
prove | 测试运行器 |
| subtest | 子测试组织 |
练习
- 为一个简单模块编写完整测试(t/ 目录)
- 使用 Test::Mojo 测试 REST API 的所有端点
- 编写 subtest 组织相关测试
- 使用
prove -j4 并行运行测试 - 为你的测试添加 TODO 和 skip 标记
扩展阅读