1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
use strict;
use warnings;
use Test2::API qw(intercept);
use Test::More;
use Test::Routine::Util;
{
package ThisFails;
use Test::Routine;
use Test::More;
test "this test will pass" => sub {
pass("one");
pass("two");
pass("three");
};
test "this test will fail" => sub {
pass("one");
fail("two");
pass("three");
};
around run_test => sub {
my ($orig, $self, @rest) = @_;
my $rc = $self->$orig(@rest);
diag $rc ? "pass-result" : "fail-result";
};
}
my $events = intercept {
run_tests("test run with aborts", 'ThisFails');
};
my @top = grep {; $_->isa('Test2::Event::Subtest') } @$events;
is(@top, 1, "we have one top-level subtest for Routine");
my @subtests = grep {; $_->isa('Test2::Event::Subtest') }
@{ $top[0]->subevents };
is(@subtests, 2, "we ran two subtests (the two test methods)");
subtest "first subtest" => sub {
my @subevents = @{ $subtests[0]->subevents };
my @oks = grep {; $_->isa('Test2::Event::Ok') } @subevents;
is(@oks, 3, "three pass/fail events");
ok($oks[0]->pass, "assertion passed");
is($oks[0]->name, "one", "correct name");
ok($oks[1]->pass, "assertion passed");
is($oks[1]->name, "two", "correct name");
ok($oks[2]->pass, "assertion passed");
is($oks[2]->name, "three", "correct name");
};
subtest "second subtest" => sub {
my @subevents = @{ $subtests[1]->subevents };
my @oks = grep {; $_->isa('Test2::Event::Ok') } @subevents;
is(@oks, 3, "three pass/fail events");
ok($oks[0]->pass, "assertion passed");
is($oks[0]->name, "one", "correct name");
ok(!$oks[1]->pass, "assertion failed");
is($oks[1]->name, "two", "correct name");
ok($oks[2]->pass, "assertion passed");
is($oks[2]->name, "three", "correct name");
};
{
my @diags = grep {; $_->isa('Test2::Event::Diag') } @{ $top[0]->subevents };
is(
(grep {; $_->message eq 'pass-result' } @diags),
1,
"we got one pass-result",
);
is(
(grep {; $_->message eq 'fail-result' } @diags),
1,
"we got one fail-result",
);
};
done_testing;
__END__
|
