perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Randy Kobes <ra...@theoryx5.uwinnipeg.ca>
Subject Re: t/SMOKE on win32
Date Fri, 03 Oct 2003 05:23:07 GMT
On Thu, 2 Oct 2003, Stas Bekman wrote:

> Steve Hay wrote:
>
> > BTW, Why is it ">&STDIN"?  I would have thought "<&STDIN" makes more
> > sense.  Anyway, I tried rebuilding everything with "<&STDIN" and it made
> > no difference - testsuite OK, smoke NOT OK.
>
> Another good catch, I've committed the fix. Thank you, Steve.
>
> >>>> Can you reproduce this problem outside t/SMOKE? You should be able
> >>>> to by doing:
> >>>>
> >>>> t/TEST -start
> >>>> t/TEST -run modperl\cookie
> >>>> t/TEST -stop
> >>>>
> >>>> since that's what t/SMOKE does
> >>>
> >>>
> >>> No - I tried that half a dozen or more times, and it worked fine
> >>> every time, with or without your patch.
> >>>
> >>> The last failure that I had (with your patch in place) was on only
> >>> the second test that it tried, so I tried running them both like this:
> >>>
> >>>    perl t/TEST -start
> >>>    perl t/TEST filter\out_str_req_mix
> >>>    perl t/TEST modperl\env
> >>>    perl t/TEST -stop
> >>>
> >>> to try and reproduce what the SMOKE had actually done, but that
> >>> worked too!
> >>
> >> So is it possible that the bug comes from perl? This randomness is
> >> troubling. (Did you have some magnetic storms in England recently? ;)
> >
> > Funny you should mention that - the weather has just taken a turn for
> > the worse!
>
> Hope that the problem will disappear as the sun will come out ;)
>
> >> can you write a plain perl script that does:
> >>
> >>   open my $oldout, ">&STDIN" or die "Can't dup STDIN: $!";
> >>   then restores it and then re-opens again? and try to run it several
> >> times (outside modperl)?
> >
> >
> > Is this the sort of thing you had in mind?:-
>
> Yup.
>
> > =====
> > use strict;
> > use warnings;
> > for (1 .. 100) {
> >    open my $oldin, "<&STDIN" or die "Can't dup STDIN: $!";
> >    close STDIN;
> >    printf "Dupped STDIN as fileno %d\n", fileno $oldin;
> >    open STDIN, "<&", $oldin or die "Can't restore STDIN: $!";
> >    close $oldin;
> >    printf "Restored STDIN as fileno %d\n", fileno STDIN;
> > }
> > =====
> >
> > I've called the variable $oldin rather than $oldout, and used "<" rather
> > than ">".  (Otherwise Perl warns "Filehandle STDIN reopened as STDIN
> > only for output" when restoring STDIN.)
> >
> > The above runs fine using the same Perl (5.8.1) that I'm running
> > mod_perl-1.99_10 with.  (It also works OK with ">" instead of "<" aside
> > from the warnings from Perl.)
>
> Thanks, it's probably more involved than this then.
>
> I'm thinking that you may get this error if STDIN was already closed before it
> was attempted to be dupped. If only you could reliably reproduce the problem.
>
> Another peculiar thing about this problem is that Randy
> doesn't seem to have this problem. Can you try and compare
> your environments/builds and see why it's only you who
> gets it?

It may be that I've just not tested it extensively enough to
run into this problem ... Steve, could you try the patch
below - the difference between this one and the previous one
is that this one passes "undef" in for STDIN, which allows
the child to inherit the parent's STDIN, whereas the earlier
one passed in \undef, which was equivalent to /dev/null.

I've tried testing this, and haven't come across a problem
yet, but this wasn't very extensive, as it's late ...
(Stas, I've kept in the "print $log" statements just
for debugging purposes).
===========================================================
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 05:15:00 -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,11 @@
     # 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;
+        $started_ok = 1 if $log =~ /started/;
         unless ($started_ok) {
             error "failed to start server\n $log";
             exit 1;
@@ -507,19 +503,12 @@
             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/;
-            }
-            # 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;
+            $ok = 1 if $log =~ /All tests successful/;

             my @core_files_msg = $self->Apache::TestRun::scan_core_incremental;

@@ -594,16 +583,11 @@
     # 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;
+        $stopped_ok = 1 if $log =~ /shutdown/;
         unless ($stopped_ok) {
             error "failed to stop server\n $log";
             exit 1;
=============================================================
-- 
best regards,
randy

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message