On Fri, 3 Oct 2003, Steve Hay wrote:
> I still worry that I've got something terribly wrong,
> though. Surely it should at least start running some
> tests? I was expecting it to either work, or else fail as
> before with the "Failed to dup STDOUT" error on certain
> (not-so-)random tests.
>
> Does my patch work on Linux? If not then I have got it
> all wrong, and we're not still staring at a Win32 problem.
Actually, the patch did also make linux hang ... Here's
one which does work on linux - the intent here is to
dup/redirect STDOUT/STDERR before calling run3 $command,
so that run3 inherits the parent's STDOUT/STDERR/STDIN.
============================================================
Index: Apache-Test/lib/Apache/TestSmoke.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm,v
retrieving revision 1.23
diff -u -r1.23 TestSmoke.pm
--- Apache-Test/lib/Apache/TestSmoke.pm 12 Sep 2003 02:47:41 -0000 1.23
+++ Apache-Test/lib/Apache/TestSmoke.pm 3 Oct 2003 21:07:42 -0000
@@ -15,7 +15,8 @@
use FindBin;
use POSIX ();
use Symbol ();
-
+use IPC::Run3;
+use File::Temp qw(tempfile);
#use constant DEBUG => 1;
# how many times to run all tests at the first iteration
@@ -111,7 +112,7 @@
@{ $self->{tests} } = $self->get_tests($test_opts);
- $self->{base_command} = "./TEST";
+ $self->{base_command} = "$^X $FindBin::Bin/TEST";
# options common to all
$self->{base_command} .= " -verbose" if $self->{verbose};
@@ -473,16 +474,13 @@
# start server
{
my $command = $self->{start_command};
- open my $pipe, "$command 2>&1|" or die "cannot fork: $!";
- my $oldfh = select $pipe; $| = 1; select $oldfh;
- # XXX: check startup success?
my $started_ok = 0;
my $log = '';
- while (my $t = <$pipe>) {
- $started_ok = 1 if $t =~ /started/;
- $log .= $t;
+ unless ($log = run_command($command)) {
+ error "Error running $command";
+ exit 1;
}
- close $pipe;
+ $started_ok = 1 if $log =~ /started/;
unless ($started_ok) {
error "failed to start server\n $log";
exit 1;
@@ -507,19 +505,14 @@
my $fill = "." x ($max_len - length $test_name);
$self->{total_tests_run}++;
- open my $pipe, "$command $test 2>&1|" or die "cannot fork: $!";
- my $oldfh = select $pipe; $| = 1; select $oldfh;
-
+ my $test_command = "$command $test";
my $ok = 0;
my $log = '';
- while (<$pipe>) {
- $log .= $_;
-
- $ok = 1 if /All tests successful/;
+ unless ($log = run_command($test_command)) {
+ error "Error running $test_command";
+ exit 1;
}
- # it's normal for $command to exit with a failure status if tests
- # fail, so we don't die/report it
- close $pipe;
+ $ok = 1 if $log =~ /All tests successful/;
my @core_files_msg = $self->Apache::TestRun::scan_core_incremental;
@@ -594,16 +587,13 @@
# stop server
{
my $command = $self->{stop_command};
- open my $pipe, "$command 2>&1|" or die "cannot fork: $!";
- my $oldfh = select $pipe; $| = 1; select $oldfh;
- # XXX: check stopup success?
my $stopped_ok = 0;
my $log = '';
- while (my $t = <$pipe>) {
- $stopped_ok = 1 if $t =~ /shutdown/;
- $log .= $t;
+ unless ($log = run_command($command)) {
+ error "Error running $command";
+ exit 1;
}
- close $pipe;
+ $stopped_ok = 1 if $log =~ /shutdown/;
unless ($stopped_ok) {
error "failed to stop server\n $log";
exit 1;
@@ -628,6 +618,46 @@
}
+}
+
+sub run_command {
+ my $command = shift;
+ my ($fh, $file) = tempfile(UNLINK => 1);
+ open my $savout, ">&STDOUT" or do {
+ error "Can't dup STDOUT: $!";
+ return;
+ };
+ open my $saverr, ">&STDERR" or do {
+ error "Can't dup STDERR: $!";
+ return;
+ };
+ close STDOUT; close STDERR;
+ open STDOUT, '>', $file or do {
+ error "Can't redirect STDOUT: $!";
+ return;
+ };
+ open STDERR, '>&STDOUT' or do {
+ error "Can't redirect STDERR: $!";
+ return;
+ };
+ select STDERR; $| = 1;
+ select STDOUT; $| = 1;
+ run3 $command;
+ close STDOUT; close STDERR;
+ open STDOUT, '>&', $savout or do {
+ error "Can't restore STDOUT: $!";
+ return;
+ };
+ open STDERR, '>&', $saverr or do {
+ error "Can't restore STDERR: $!";
+ return;
+ };
+ close $savout; close $saverr;
+ local $/;
+ my $log = <$fh>;
+ close $fh;
+ print $log;
+ return $log;
}
sub report_start {
===============================================================
--
best regards,
randy
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
