| Subject: | Windows doesn't fork (t\local\back.t) |
In t\local\back.t, the fork() function hangs indefinitely. This is a major source of annoyance for all automated installations on Windows, which use fork() in tests. There are claims that Windows supports fork(), but I have yet to ever see a Windows OS and Perl version that works.
Attached is a patch to skip any testing that involves fork() in t\local\back.t. This works on Win2k Pro and WinXP. I would have tested on Win98, but my box is now broken :(
--- WWW-Mechanize-1.16/t/local/back.t Mon Oct 31 19:07:42 2005
+++ WWW-Mechanize-1.16_01/t/local/back.t Mon Oct 31 19:03:17 2005
@@ -128,38 +128,41 @@
my $server404 = HTTP::Daemon->new or die;
my $server404url = $server404->url;
-die "Cannot fork" if (! defined (my $pid404 = fork()));
-END {
- local $?;
- kill KILL => $pid404; # Extreme prejudice intended, because we do not
- # want the global cleanup to be done twice.
-}
+SKIP: {
+ skip "Cannot fork", 10 if ($^O eq 'MSWin32' || ! defined (my $pid404 = fork()));
-if (! $pid404) { # Fake HTTP server code: a true 404-compliant server!
- while ( my $c = $server404->accept() ) {
- while ( $c->get_request() ) {
- $c->send_response( new HTTP::Response(404) );
- $c->close();
+ END {
+ local $?;
+ kill KILL => $pid404; # Extreme prejudice intended, because we do not
+ # want the global cleanup to be done twice.
+ }
+
+ if (! $pid404) { # Fake HTTP server code: a true 404-compliant server!
+ while ( my $c = $server404->accept() ) {
+ while ( $c->get_request() ) {
+ $c->send_response( new HTTP::Response(404) );
+ $c->close();
+ }
}
}
-}
-$mech->get($server404url);
-is( $mech->status, 404 , "404 check");
+ $mech->get($server404url);
+ is( $mech->status, 404 , "404 check");
-is( scalar @{$mech->{page_stack}}, 1, "Even 404s get on the stack" );
+ is( scalar @{$mech->{page_stack}}, 1, "Even 404s get on the stack" );
-$mech->back();
-is( $mech->uri, $server->url, "Back from the 404" );
-is( scalar @{$mech->{page_stack}}, 0, "Post-404 check" );
+ $mech->back();
+ is( $mech->uri, $server->url, "Back from the 404" );
+ is( scalar @{$mech->{page_stack}}, 0, "Post-404 check" );
-for my $link ( @links ) {
- $mech->get( $link );
- warn $mech->status() if (! $mech->success());
- is( $mech->status, 200, "Get $link" );
+ for my $link ( @links ) {
+ $mech->get( $link );
+ warn $mech->status() if (! $mech->success());
+ is( $mech->status, 200, "Get $link" );
- $mech->back();
- is( $mech->uri, $server->url, "Back from $link" );
+ $mech->back();
+ is( $mech->uri, $server->url, "Back from $link" );
+ }
}
SKIP: {