Commit | Line | Data |
---|---|---|
4dd974da JH |
1 | # For testing Test::Simple; |
2 | package Catch; | |
3 | ||
4 | my $out = tie *Test::Simple::TESTOUT, 'Catch'; | |
5 | my $err = tie *Test::Simple::TESTERR, 'Catch'; | |
6 | ||
7 | # We have to use them to shut up a "used only once" warning. | |
8 | () = (*Test::Simple::TESTOUT, *Test::Simple::TESTERR); | |
9 | ||
10 | sub caught { return $out, $err } | |
11 | ||
12 | # Prevent Test::Simple from exiting in its END block. | |
13 | *Test::Simple::exit = sub {}; | |
14 | ||
15 | sub PRINT { | |
16 | my $self = shift; | |
17 | $$self .= join '', @_; | |
18 | } | |
19 | ||
20 | sub TIEHANDLE { | |
21 | my $class = shift; | |
22 | my $self = ''; | |
23 | return bless \$self, $class; | |
24 | } | |
25 | sub READ {} | |
26 | sub READLINE {} | |
27 | sub GETC {} | |
28 | ||
29 | 1; |