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
|
use Test2::Bundle::Extended;
use Test2::AsyncSubtest;
use Test2::Tools::Compare qw{ array event field };
use Test2::IPC;
use Test2::Util qw/CAN_REALLY_FORK CAN_THREAD get_tid/;
sub DO_THREADS {
return 0 unless $ENV{AUTHOR_TESTING} || $ENV{T2_DO_THREAD_TESTS};
return Test2::AsyncSubtest->CAN_REALLY_THREAD;
}
my $wrap = Test2::AsyncSubtest->new(name => 'wrap');
$wrap->start;
my $t1 = Test2::AsyncSubtest->new(name => 't1');
my $t2 = Test2::AsyncSubtest->new(name => 't2');
$wrap->stop;
$_->run(sub {
ok(1, "not concurrent A");
}) for $t1, $t2;
ok(1, "Something else");
if (CAN_REALLY_FORK) {
my @pids;
$_->run(sub {
my $id = $_->cleave;
my $pid = fork;
die "Failed to fork!" unless defined $pid;
if ($pid) {
push @pids => $pid;
return;
}
my $ok = eval {
$_->attach($id);
ok(1, "from proc $$");
$_->detach();
1
};
exit 0 if $ok;
warn $@;
exit 255;
}) for $t1, $t2;
waitpid($_, 0) for @pids;
}
ok(1, "Something else");
if (DO_THREADS()) {
require threads;
my @threads;
$_->run(sub {
my $id = $_->cleave;
push @threads => threads->create(sub {
$_->attach($id);
ok(1, "from thread " . get_tid);
$_->detach();
});
}) for $t1, $t2;
$_->join for @threads;
}
$_->run(sub {
ok(1, "not concurrent B");
}) for $t1, $t2;
ok(1, "Something else");
ok($wrap->pending, "Pending stuff");
$_->finish for $t1, $t2;
ok(!$wrap->pending, "Ready now");
$wrap->finish;
is(
intercept {
my $t = Test2::AsyncSubtest->new(name => 'will die');
$t->run(sub { die "kaboom!\n" });
$t->finish;
},
array {
event Subtest => sub {
field name => 'will die';
field subevents => array {
event Exception => sub {
field error => "kaboom!\n";
};
event Plan => sub {
field max => 0;
};
};
};
event Diag => sub {
field message => match qr/\QFailed test 'will die'/;
};
end();
},
'Subtest that dies not add a diagnostic about a bad plan'
);
my $sta = Test2::AsyncSubtest->new(name => 'collapse: empty');
my $stb = Test2::AsyncSubtest->new(name => 'collapse: note only');
my $stc = Test2::AsyncSubtest->new(name => 'collapse: full');
$stb->run(sub { note "inside" });
$stc->run(sub { ok(1, "test") });
$sta->finish(collapse => 1);
$stb->finish(collapse => 1);
$stc->finish(collapse => 1);
done_testing;
|
