#!/opt/perl58/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 = 'lib/HTML/Display/Win32/OLE.pm'; 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 $!; SKIP: { # A header testing whether we find all prerequisites : # Check for module base eval { require base }; skip "Need module base to run this test", 1 if $@; # The original POD test undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 13 lib/HTML/Display/Win32/OLE.pm package HTML::Display::Win32::OleControl; use parent 'HTML::Display::Win32::OLE'; sub new { my $class = shift; $class->SUPER::new( app_string => "FooBrowser.Application", @_ ); $self; }; my $browser = HTML::Display->new( class => 'HTML::Display::Win32::OleControl', ); $browser->display("

Hello world!

"); ; } }; is($@, '', "example from line 13"); }; SKIP: { # A header testing whether we find all prerequisites : # The original POD test undef $main::_STDOUT_; undef $main::_STDERR_; };