On Wed, 17 Sep 2003, Steve Hay wrote:
> Stas Bekman wrote:
> >
> > Steve Hay wrote:
> > > I tried running "perl t/SMOKE" but I just get this:
> > >
> > > =====
> > > C:\Temp\modperl-2.0>perl t/SMOKE
> > > *** Using random number seed: 1012582729 (autogenerated)
> > > ***
> > > ------------------------------------------------------------
> > > *** [001-00-00] trying all tests 10 times
> > > !!! failed to start server
> > > '.' is not recognized as an internal or external command,
> > > operable program or batch file.
> > > =====
> >
> > Yup, it needs tweaking to run on win32.
Here's a first stab at a patch to get t/SMOKE running on
Win32. I tried to localize the Win32 changes by putting
them in their own sub. The full functionality is probably
not all there - it still needs more testing - but it does
seem workable in principle.
========================================================
Index: 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
--- lib/Apache/TestSmoke.pm 12 Sep 2003 02:47:41 -0000 1.23
+++ lib/Apache/TestSmoke.pm 30 Sep 2003 05:42:39 -0000
@@ -16,6 +16,12 @@
use POSIX ();
use Symbol ();
+use constant WIN32 => Apache::TestConfig::WIN32;
+if (WIN32) {
+ require Win32;
+ require Win32::Process;
+}
+
#use constant DEBUG => 1;
# how many times to run all tests at the first iteration
@@ -111,7 +117,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};
@@ -462,6 +468,13 @@
sub run_test {
my($self, $iter, $count, $tests, $ra_ok) = @_;
+ my $run_test = \&{"run_test_$^O"};
+ $run_test = \&run_test_default unless defined &$run_test;
+ $run_test->($self, $iter, $count, $tests, $ra_ok);
+}
+
+sub run_test_default {
+ my($self, $iter, $count, $tests, $ra_ok) = @_;
my $bad = '';
my $ra_nok = [];
@@ -627,6 +640,129 @@
return $bad;
}
+
+}
+
+sub run_test_MSWin32 {
+ my($self, $iter, $count, $tests, $ra_ok) = @_;
+ my $bad = '';
+ my $ra_nok = [];
+ my $ProcessObj;
+
+ # start server
+ {
+ my $cmd = $self->{start_command};
+ my $cflags = Win32::Process::NORMAL_PRIORITY_CLASS();
+ my $shell = $ENV{ComSpec};
+ Win32::Process::Create($ProcessObj,
+ $shell,
+ "$shell /c $cmd",
+ 0,
+ $cflags,
+ '.')
+ or die Win32::FormatMessage(Win32::GetLastError());
+ $ProcessObj->Wait(Win32::Process::INFINITE());
+ }
+ my $t_logs = $self->{test_config}->{vars}->{t_logs};
+ my @log_files = map { catfile $t_logs, $_ } qw(error_log access_log);
+ $self->logs_init(@log_files);
+
+ # run tests
+ {
+ my $command = $self->{run_command};
+
+ my $max_len = 1;
+ for my $test (@$tests) {
+ $max_len = length $test if length $test > $max_len;
+ }
+
+ for my $test (@$tests) {
+ my $ok = 0;
+ my $log = '';
+ (my $test_name = $test) =~ s/\.t$//;
+ my $fill = "." x ($max_len - length $test_name);
+ $self->{total_tests_run}++;
+
+ my @args = (split(' ', $command), $test);
+ $ok = not system(@args);
+ if ($ok) {
+ push @$ra_ok, $test;
+ if ($self->{verbose}) {
+ print STDERR "$test_name${fill}ok\n";
+ }
+ # need to run log_diff to reset the position of the fh
+ my %log_diffs = map { $_ => $self->log_diff($_) } @log_files;
+
+ }
+ else {
+ push @$ra_nok, $test;
+ $bad = $test;
+
+ if ($self->{verbose}) {
+ print STDERR "$test_name${fill}FAILED\n";
+ error sep("-");
+
+ # give server some time to finish the
+ # logging. it's ok to wait long time since we have
+ # to deal with an error
+ sleep 5;
+ my %log_diffs = map { $_ => $self->log_diff($_) } @log_files;
+
+ # client log
+ error "\t\t*** run log ***";
+ $log =~ s/^/ /mg;
+ print STDERR "$log\n";
+
+ # server logs
+ for my $path (@log_files) {
+ next unless length $log_diffs{$path};
+ error "\t\t*** $path ***";
+ $log_diffs{$path} =~ s/^/ /mg;
+ print STDERR "$log_diffs{$path}\n";
+ }
+ }
+
+ if ($self->{verbose}) {
+ error sep("-");
+ }
+
+ unless ($self->{bug_mode}) {
+ # normal smoke stop the run, but in the bug_mode
+ # we want to complete all the tests
+ last;
+ }
+ }
+ }
+ }
+ $self->logs_end();
+
+
+ # stop server
+ {
+ my $pid;
+ if ($ProcessObj) {
+ $pid = $ProcessObj->GetProcessID();
+ $ProcessObj->Kill(0);
+ }
+ if ($pid) {
+ Win32::Process::KillProcess($pid, 0);
+ }
+ }
+ $self->kill_proc();
+
+ if ($self->{bug_mode}) {
+ warning sep("-");
+ if (@$ra_nok == 0) {
+ printf STDERR "All tests successful (%d)\n", scalar @$ra_ok;
+ }
+ else {
+ error sprintf "error running %d tests out of %d\n",
+ scalar(@$ra_nok), scalar @$ra_ok + @$ra_nok;
+ }
+ }
+ else {
+ return $bad;
+ }
}
=============================================================
--
best regards,
randy
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
