On Wed, 8 Oct 2003, Stas Bekman wrote:
> Steve Hay wrote:
[ .. ]
> Do you have the same issue if you run them as:
>
> perl t/TEST testname
>
> instead of using 'nmake'? If that's the case, it's not an issue with SMOKE.
Running the tests that fail under t/SMOKE as
perl t/TEST testname
reports them passing.
> > I assumed it was something to do with the IPC::Run3 stuff in
> > TestSmoke.pm that we've been playing with (specifically the fact that it
> > introduces new redirections of its own), and I was under the impression
> > that it is only t/SMOKE that uses this TestSmoke module. Is that not
> > the case?
>
> Yes. But Smoke does nothing else but starting t/TEST and feeding tests to it,
> execution-wise. Anything that fails with t/SMOKE should fail the same way with
> t/TEST.
>
> > My thinking was that maybe the redirections in TestSmoke clash with the
> > redirections done by perl-script, but they're fine with the modperl
> > handler because that doesn't do any redirections of its own.
>
> I doubt so, since the problem comes from the server, which
> has no idea what the client does, and has a totally
> different process environment, so I fail to see how the
> client can affect it. Unless there is something special
> about win32.
I've attached a patch (for Steve's benefit, as it's Win32
specific) which, first of all, uses Win32::Process (to
rule out problems coming from IPC::Run3), and which defines
two functions:
run_command - uses system() to run a command, and
returns a flag indicating success;
run_command_dup - uses Win32::Process to run a command,
capturing the STDOUT and STDERR and
then returning the text.
- if one uses run_command_dup to start/stop the server and
run the tests, then the error with failing to dup STDOUT
results, for those tests that use perl-script.
- if one uses run_command_dup to start/stop the server, but
uses run_command to run the tests, then the same error
results.
- if one uses run_command to start/stop the server and run
the tests, then all tests pass.
--
best regards,
randyIndex: 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 9 Oct 2003 01:12:07 -0000
@@ -15,9 +15,16 @@
use FindBin;
use POSIX ();
use Symbol ();
-
+#use IPC::Run3;
+use File::Temp qw(tempfile);
#use constant DEBUG => 1;
+use constant WIN32 => Apache::TestConfig::WIN32;
+if (WIN32) {
+ require Win32;
+ require Win32::Process;
+}
+
# how many times to run all tests at the first iteration
use constant DEFAULT_TIMES => 10;
@@ -111,7 +118,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 +480,14 @@
# 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, 0)) {
+ error "Error running $command";
+ exit 1;
}
- close $pipe;
+ #$started_ok = 1 if $log =~ /started/;
+ $started_ok = 1;
unless ($started_ok) {
error "failed to start server\n $log";
exit 1;
@@ -507,19 +512,15 @@
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, 1)) {
+ 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/;
+ $ok = 1;
my @core_files_msg = $self->Apache::TestRun::scan_core_incremental;
@@ -594,16 +595,14 @@
# 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, 0)) {
+ error "Error running $command";
+ exit 1;
}
- close $pipe;
+ #$stopped_ok = 1 if $log =~ /shutdown/;
+ $stopped_ok = 1;
unless ($stopped_ok) {
error "failed to stop server\n $log";
exit 1;
@@ -628,6 +627,59 @@
}
+}
+
+sub run_command {
+ my $command = shift;
+ my @args = split ' ', $command;
+ return not system(@args);
+}
+
+sub run_command_dup {
+ require Win32;
+ require Win32::Process;
+ my ($command, $is_test) = @_;
+ my $procObj;
+ my $shell = $ENV{ComSpec};
+ my ($fh, $file) = tempfile();
+ open my $oldout, '>&STDOUT' or die "Can't dup STDOUT : $!\n";
+ open my $olderr, '>&STDERR' or die "Can't dup STDERR : $!\n";
+ unless (open STDOUT, ">", $file) {
+ my $err = $!;
+ open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
+ die "Can't open the output file : $err\n";
+ }
+ unless (open STDERR, ">&STDOUT") {
+ my $err = $!;
+ open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
+ die "Can't open the output file : $err\n";
+ }
+ select STDERR; $| = 1;
+ select STDOUT; $| = 1;
+ my $n = $is_test ? 1 : 0;
+ my $flags = Win32::Process::NORMAL_PRIORITY_CLASS();
+ Win32::Process::Create($procObj,
+ $shell,
+ "$shell /c $command",
+ $n,
+ $flags,
+ ".") or die "Can't start the process $^E\n";
+ close STDERR;
+ close STDOUT;
+ open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
+ open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
+ close $oldout;
+ close $olderr;
+ $procObj->Wait(Win32::Process::INFINITE());
+ my $log;
+ {
+ local $/;
+ seek $fh, 0, 0;
+ $log = <$fh>;
+ close $fh;
+ }
+ print $log;
+ return $log;
}
sub report_start {
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
