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
|
use Test2::V0;
require IO::Handle;
BEGIN {
if (eval { require Capture::Tiny; 1 }) {
Capture::Tiny->import('capture');
*CAPTURE_TINY = sub { 1 };
}
else {
*CAPTURE_TINY = sub { 0 };
}
}
my $events = intercept {
require Test2::Plugin::IOEvents;
Test2::Plugin::IOEvents->import;
print "Hello\n";
print STDOUT "Hello STDOUT\n";
print STDERR "Hello STDERR\n";
warn "Hello WARN\n";
subtest foo => sub {
ok(1, "assert");
print "Hello\n";
print STDOUT "Hello STDOUT\n";
print STDERR "Hello STDERR\n";
warn "Hello WARN\n";
};
};
like(
$events,
[
{info => [{tag => 'STDOUT', details => "Hello\n"}]},
{info => [{tag => 'STDOUT', details => "Hello STDOUT\n"}]},
{info => [{tag => 'STDERR', details => "Hello STDERR\n"}]},
{info => [{tag => 'STDERR', details => "Hello WARN\n"}]},
{
subevents => [
{}, # The assert
{info => [{tag => 'STDOUT', details => "Hello\n"}]},
{info => [{tag => 'STDOUT', details => "Hello STDOUT\n"}]},
{info => [{tag => 'STDERR', details => "Hello STDERR\n"}]},
{info => [{tag => 'STDERR', details => "Hello WARN\n"}]},
],
}
],
"Got the output in the right places, output from subtests is in subtests"
);
my $fh = \*STDOUT;
if (IO::Handle->can('autoflush')) {
$fh->autoflush(1);
is($fh->autoflush, 1, "set autoflush");
}
is(syswrite(STDOUT, ""), 0, "syswrite works");
if (CAPTURE_TINY()) {
my ($stdout, $stderr, $exit) = capture {
print STDOUT "Hello STDOUT\n";
print STDERR "Hello STDERR\n";
};
is($stdout, "Hello STDOUT\n", "captured stdout");
is($stderr, "Hello STDERR\n", "captured stderr");
}
ok(open(my $fh1, '>&', STDOUT), "Can clone STDOUT", $!);
open(STDOUT, '>&', *STDERR) or die "Could not change STDOUT: $!";
is(fileno(STDOUT), 1, "kept filehandle");
open(STDOUT, '>&', $fh1) or die "Could not change STDOUT: $!";
is(fileno(STDOUT), 1, "kept filehandle");
close($fh1);
untie(*STDERR);
ok(open(my $fh2, '>&', STDERR), "Can clone STDERR after untie", $!);
close($fh2);
done_testing;
|
