|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
use File::Spec;
|
|
Packit |
a38e86 |
use FindBin qw($Bin);
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
use IPC::Open3;
|
|
Packit |
a38e86 |
use Test::More;
|
|
Packit |
a38e86 |
use Config;
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
my $pid = undef;
|
|
Packit |
a38e86 |
my $stdout = undef;
|
|
Packit |
a38e86 |
my $stderr = undef;
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
# get path to perldoc exec in a hopefully platform neutral way..
|
|
Packit |
a38e86 |
my ($volume, $bindir, undef) = File::Spec->splitpath($Bin);
|
|
Packit |
a38e86 |
my $perldoc = File::Spec->catpath($volume,$bindir, File::Spec->catfile(qw(blib script perldoc)));
|
|
Packit |
a38e86 |
my @dir = ($bindir,"lib","Pod");
|
|
Packit |
a38e86 |
my $podpath = File::Spec->catdir(@dir);
|
|
Packit |
a38e86 |
my $good_podfile = File::Spec->catpath($volume,$podpath,"Perldoc.pm");
|
|
Packit |
a38e86 |
my $bad_podfile = File::Spec->catpath($volume,$podpath,"asdfsdaf.pm");
|
|
Packit |
a38e86 |
if ($ENV{PERL_CORE}) {
|
|
Packit |
a38e86 |
$perldoc = File::Spec->catfile('..','..','utils',
|
|
Packit |
a38e86 |
($Config{usecperl}?'c':'').'perldoc');
|
|
Packit |
a38e86 |
@dir = ("lib","Pod");
|
|
Packit |
a38e86 |
$good_podfile = File::Spec->catfile(@dir,"Perldoc.pm");
|
|
Packit |
a38e86 |
$bad_podfile = File::Spec->catfile(@dir,"asdfsdaf.pm");
|
|
Packit |
a38e86 |
}
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
plan tests => 7;
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
# First, look for something that should be there
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
eval{
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
$pid = open3(\*CHLD_IN,\*CHLD_OUT1,\*CHLD_ERR1,"$^X " .$perldoc." ".$good_podfile);
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
};
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
is(length($@),0,"open succeeded"); # returns '' not undef
|
|
Packit |
a38e86 |
ok(defined($pid),"got process id");
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
#gather STDOUT
|
|
Packit |
a38e86 |
while(<CHLD_OUT1>){
|
|
Packit |
a38e86 |
$stdout .=$_;
|
|
Packit |
a38e86 |
}
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
#check STDOUT
|
|
Packit |
a38e86 |
like($stdout,qr/Look up Perl documentation/,"got expected output in STDOUT");
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
while(<CHLD_ERR1>){
|
|
Packit |
a38e86 |
$stderr .=$_;
|
|
Packit |
a38e86 |
}
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
#is($stderr,undef,"no output to STDERR as expected");
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
# Then look for something that should not be there
|
|
Packit |
a38e86 |
$stdout = undef;
|
|
Packit |
a38e86 |
$stderr = undef;
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
eval{
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
$pid = open3(\*CHLD_IN,\*CHLD_OUT2,\*CHLD_ERR2,"$^X " .$perldoc." ".$bad_podfile);
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
};
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
is(length($@),0,"open succeeded"); # returns '' not undef
|
|
Packit |
a38e86 |
ok(defined($pid),"got process id");
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
#gather STDOUT
|
|
Packit |
a38e86 |
while(<CHLD_OUT2>){
|
|
Packit |
a38e86 |
$stdout .=$_;
|
|
Packit |
a38e86 |
}
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
#check STDOUT
|
|
Packit |
a38e86 |
is($stdout,undef,"no output to STDOUT as expected");
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
while(<CHLD_ERR2>){
|
|
Packit |
a38e86 |
$stderr .=$_;
|
|
Packit |
a38e86 |
}
|
|
Packit |
a38e86 |
|
|
Packit |
a38e86 |
like($stderr,qr/No documentation/,"got expected output in STDERR");
|
|
Packit |
a38e86 |
|