t/lib/Test/Simple/Catch.pm

   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;