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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
use Test2::Bundle::Extended;
use Test2::AsyncSubtest;
use Test2::Tools::AsyncSubtest;
use Test2::Tools::Compare qw{ array event call T };
use Test2::IPC;
use Test2::Util qw/CAN_REALLY_FORK/;
use Test2::API qw/context context_do intercept/;
sub DO_THREADS {
return 0 unless $ENV{AUTHOR_TESTING} || $ENV{T2_DO_THREAD_TESTS};
return Test2::AsyncSubtest->CAN_REALLY_THREAD;
}
skip_all 'These tests require forking or threading'
unless CAN_REALLY_FORK || DO_THREADS();
subtest(
'fork tests',
sub {
run_tests('fork');
stress_tests('fork');
}
) if CAN_REALLY_FORK;
subtest(
'thread tests',
sub {
run_tests('thread');
stress_tests('thread');
}
) if DO_THREADS();
done_testing;
sub run_tests {
my $type = shift;
my $st_sub = $type eq 'fork' ? \&fork_subtest : \&thread_subtest;
is(
intercept {
$st_sub->(
'$ctx->plan(0, SKIP)',
sub {
skip_all 'because';
ok(0, "Should not see");
}
)->finish;
},
array {
event Subtest => sub {
call name => '$ctx->plan(0, SKIP)';
call pass => T();
call subevents => array {
event '+Test2::AsyncSubtest::Event::Attach';
event Plan => sub {
call directive => 'SKIP';
call reason => 'because';
};
event '+Test2::AsyncSubtest::Event::Detach';
end();
};
};
end();
},
qq[${type}_subtest with skip_all]
);
is(
intercept {
$st_sub->(
'skip_all',
{ manual_skip_all => 1 },
sub {
skip_all 'because';
note "Post skip";
return;
}
)->finish;
},
array {
event Subtest => sub {
call name => 'skip_all';
call pass => T();
call subevents => array {
event '+Test2::AsyncSubtest::Event::Attach';
event Plan => sub {
call directive => 'SKIP';
call reason => 'because';
};
event Note => { message => 'Post skip' };
event '+Test2::AsyncSubtest::Event::Detach';
end();
};
};
end();
},
qq[${type}_subtest with skip_all and manual skip return}]
);
my $method = 'run_' . $type;
is(
intercept {
my $at = Test2::AsyncSubtest->new(name => '$ctx->plan(0, SKIP)');
$at->$method(
sub {
skip_all 'because';
ok(0, "should not see");
}
);
$at->finish;
},
array {
event Subtest => sub {
call name => '$ctx->plan(0, SKIP)';
call pass => T();
call subevents => array {
event '+Test2::AsyncSubtest::Event::Attach';
event Plan => sub {
call directive => 'SKIP';
call reason => 'because';
};
event '+Test2::AsyncSubtest::Event::Detach';
end();
};
};
end();
},
qq[\$subtest->$method with skip_all]
);
}
sub stress_tests {
my $type = shift;
my $st_sub = $type eq 'fork' ? \&fork_subtest : \&thread_subtest;
for my $i (2 .. 5) {
my @st;
for my $j (1 .. $i) {
push @st, $st_sub->(
"skip all $i - $j",
sub {
skip_all 'because';
ok(0, "should not see");
}
);
}
$_->finish for @st;
}
}
|
