Re: t/SMOKE on win32

[Steve Hay]

Randy Kobes wrote:

That's right - I think it was in the way the server was
started in Apache::TestServer. Here's a diff that seems
to work, using IPC::Run3; I've tested it both with t/SMOKE
and t/TEST, on Win32. Note that I left the "print $log;"
statements in there, just to see the progress while
debugging.
Brilliant!

Your patch below seems to have fixed it all for me.  I've just set a 
smoke running; I'll let you know how it goes.  If all is well, as I'm 
sure it will be, then this should definitely be committed.

Well done, Randy!

- Steve

==========================================================
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 9 Oct 2003 07:21:17 -0000
@@ -15,6 +15,7 @@
use FindBin;
use POSIX ();
use Symbol ();
+use IPC::Run3;
#use constant DEBUG => 1;

@@ -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,10 @@
    # 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;
-        }
-        close $pipe;
+        run3 $command, undef, \$log, \$log;
+        print $log;
+        my $started_ok = ($log =~ /started/) ? 1 : 0;
        unless ($started_ok) {
            error "failed to start server\n $log";
            exit 1;
@@ -507,19 +502,11 @@
            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 $ok = 0;
+            my $test_command = "$command $test";
            my $log = '';
-            while (<$pipe>) {
-                $log .= $_;
-
-                $ok = 1 if /All tests successful/;
-            }
-            # it's normal for $command to exit with a failure status if tests
-            # fail, so we don't die/report it
-            close $pipe;
+            run3 $test_command, undef, \$log, \$log;
+            print $log;
+            my $ok = ($log =~ /All tests successful/) ? 1 : 0;
            my @core_files_msg = $self->Apache::TestRun::scan_core_incremental;

@@ -594,16 +581,10 @@
    # 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;
-        }
-        close $pipe;
+        run3 $command, undef, \$log, \$log;
+        print $log;
+        my $stopped_ok = ($log =~ /shutdown/) ? 1 : 0;
        unless ($stopped_ok) {
            error "failed to stop server\n $log";
            exit 1;
Index: Apache-Test/lib/Apache/TestServer.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.66
diff -u -r1.66 TestServer.pm
--- Apache-Test/lib/Apache/TestServer.pm        1 Oct 2003 13:45:23 -0000       1.66
+++ Apache-Test/lib/Apache/TestServer.pm        9 Oct 2003 07:21:17 -0000
@@ -316,12 +316,14 @@
    if (Apache::TestConfig::WIN32) {
        if ($self->{config}->{win32obj}) {
            $self->{config}->{win32obj}->Kill(0);
+            warning "server $self->{name} shutdown";
            return 1;
        }
        else {
            require Win32::Process;
            my $pid = $self->pid;
            Win32::Process::KillProcess($pid, 0);
+            warning "server $self->{name} shutdown";
            return 1;
        }
    }
@@ -443,7 +445,7 @@
        Win32::Process::Create($obj,
                               $httpd,
                               "$cmd $one_process",
-                               0,
+                               1,
                               Win32::Process::NORMAL_PRIORITY_CLASS(),
                               '.') || die Win32::Process::ErrorReport();
        $config->{win32obj} = $obj;
=========================================================================
 



---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]