#!/usr/bin/perl -w use Test::More 'no_plan'; package Catch; sub TIEHANDLE { my($class, $var) = @_; return bless { var => $var }, $class; } sub PRINT { my($self) = shift; ${'main::'.$self->{var}} .= join '', @_; } sub OPEN {} # XXX Hackery in case the user redirects sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want. sub READ {} sub READLINE {} sub GETC {} sub BINMODE {} my $Original_File = 't/02_tests.t'; package main; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'Catch', '_STDOUT_' or die $!; tie *STDERR, 'Catch', '_STDERR_' or die $!; { undef $main::_STDOUT_; undef $main::_STDERR_; #line 95 t/02_tests.t ok(2+2 == 4); is( __LINE__, 96 ); undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 107 t/02_tests.t my $foo = 0; is( __LINE__, 108 ); ok( !$foo, 'foo is false' ); ok( $foo == 0, 'foo is zero' ); undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 184 t/02_tests.t use File::Spec; is( $Original_File, File::Spec->catfile(qw(t 02_tests.t)) ); is( __LINE__, 188, 'line in =for testing' ); is( __LINE__, 192, 'line in =begin/end testing' ); undef $main::_STDOUT_; undef $main::_STDERR_; } undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 117 t/02_tests.t # This is an example. 2+2 == 4; 5+5 == 10; ; } }; is($@, '', "example from line 117"); undef $main::_STDOUT_; undef $main::_STDERR_; undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 127 t/02_tests.t sub mygrep (&@) { } mygrep { $_ eq 'bar' } @stuff ; } }; is($@, '', "example from line 127"); undef $main::_STDOUT_; undef $main::_STDERR_; undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 135 t/02_tests.t my $result = 2 + 2; ; } }; is($@, '', "example from line 135"); { undef $main::_STDOUT_; undef $main::_STDERR_; #line 135 t/02_tests.t my $result = 2 + 2; ok( $result == 4, 'addition works' ); is( __LINE__, 142 ); undef $main::_STDOUT_; undef $main::_STDERR_; } undef $main::_STDOUT_; undef $main::_STDERR_; undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 147 t/02_tests.t local $^W = 1; print "Hello, world!\n"; print STDERR "Beware the Ides of March!\n"; warn "Really, we mean it\n"; ; } }; is($@, '', "example from line 147"); { undef $main::_STDOUT_; undef $main::_STDERR_; #line 147 t/02_tests.t local $^W = 1; print "Hello, world!\n"; print STDERR "Beware the Ides of March!\n"; warn "Really, we mean it\n"; is( $_STDERR_, <