[Rt-commit] r3583 - in Test-HTTP-Server-Simple: .
lib/Test/HTTP/Server t
glasser at bestpractical.com
glasser at bestpractical.com
Tue Aug 2 18:23:42 EDT 2005
Author: glasser
Date: Tue Aug 2 18:23:42 2005
New Revision: 3583
Modified:
Test-HTTP-Server-Simple/Changes
Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm
Test-HTTP-Server-Simple/t/01.basic.t
Log:
THSS is now a mixin, and it does much smarter stuff with signals:
* the parent waits for the kid to be accepting connections before it returns
from started_ok
* the parent kills the kid with a gentle signal that lets the kid run END
blocks (yay for Devel::Cover)
Modified: Test-HTTP-Server-Simple/Changes
==============================================================================
--- Test-HTTP-Server-Simple/Changes (original)
+++ Test-HTTP-Server-Simple/Changes Tue Aug 2 18:23:42 2005
@@ -1,5 +1,10 @@
Revision history for Test-HTTP-Server-Simple
-0.0.1 Thu Jun 16 18:16:56 2005
+0.01 Tue Aug 02 18:16:00 2005
+ Change API to make it a mixin.
+ Make child signal parent when it's ready, and make the parent-killing-child
+ be much nicer than a -9.
+
+0.01 Thu Jun 16 18:16:56 2005
Initial release.
Modified: Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm
==============================================================================
--- Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm (original)
+++ Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm Tue Aug 2 18:23:42 2005
@@ -1,14 +1,12 @@
package Test::HTTP::Server::Simple;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
use warnings;
use strict;
use Carp;
-use Exporter;
-our @ISA = qw/Exporter/;
-our @EXPORT = qw/started_ok/;
+use NEXT;
use Test::Builder;
my $Tester = Test::Builder->new;
@@ -20,12 +18,15 @@
=head1 SYNOPSIS
+ package My::WebServer;
+ use base qw/Test::HTTP::Server::Simple HTTP::Server::Simple/;
+
+ package main;
use Test::More tests => 42;
- use Test::HTTP::Server::Simple;
-
+
my $s = My::WebServer->new;
- my $url_root = started_ok($s, "start up my web server);
+ my $url_root = $s->started_ok("start up my web server);
# connect to "$url_root/cool/site" and test with Test::WWW::Mechanize,
# Test::HTML::Tidy, etc
@@ -33,14 +34,14 @@
=head1 DESCRIPTION
-This module provides functions to test an L<HTTP::Server::Simple>-based web
-server. Currently, it provides only one such function: C<started_ok>.
+This mixin class provides methods to test an L<HTTP::Server::Simple>-based web
+server. Currently, it provides only one such method: C<started_ok>.
=over 4
-=item started_ok $server, [$text]
+=item started_ok [$text]
-C<started_ok> takes an instance of a subclass of L<HTTP::Server::Simple> and
+C<started_ok> takes
an optional test description. The server needs to have been configured (specifically,
its port needs to have been set), but it should not have been run or backgrounded.
C<started_ok> calls C<background> on the server, which forks it to run in the background.
@@ -58,24 +59,41 @@
$SIG{INT} = sub { exit };
END {
- kill 9, @CHILD_PIDS if @CHILD_PIDS;
+ kill 'USR1', @CHILD_PIDS if @CHILD_PIDS;
}
sub started_ok {
- my $server = shift;
+ my $self = shift;
my $text = shift;
$text = 'started server' unless defined $text;
- unless (UNIVERSAL::isa($server, 'HTTP::Server::Simple')) {
- $Tester->ok(0, $text);
- $Tester->diag("$server is not an HTTP::Server::Simple");
- return;
- }
-
- my $port = $server->port;
+ my $port = $self->port;
my $pid;
+
+ $self->{'test_http_server_simple_parent_pid'} = $$;
+
+ my $child_loaded_yet = 0;
+
+ # So this is a little complicated. The following signal handler does two
+ # ENTIRELY DIFFERENT things:
+ #
+ # In the parent, it just sets $child_loaded_yet, which breaks out of the
+ # while loop below. It's activated by the kid sending it a SIGUSR1 after
+ # it runs setup_listener
+ #
+ # In the kid, it sets the variable, but that's basically pointless since
+ # the call to ->background doesn't actually return in the kid. But also,
+ # it exits. And when you actually exit with 'exit' (as opposed to being
+ # killed by a signal) END blocks get run. Which means that you can use
+ # Devel::Cover to test the kid's coverage. This one is activated by the
+ # parent's END block in this file.
+
+ local $SIG{'USR1'} = sub { $child_loaded_yet = 1; exit unless $self->{'test_http_server_simple_parent_pid'} == $$ };
+
+ # XXX TODO FIXME should somehow not have the signal handler around in the
+ # kid
- eval { $pid = $server->background; };
+ eval { $pid = $self->background; };
if ($@) {
my $error_text = $@; # In case the next line changes it.
@@ -92,9 +110,29 @@
push @CHILD_PIDS, $pid;
+ $Tester->diag("Waiting for child to start up...");
+
+ 1 while not $child_loaded_yet;
+
$Tester->ok(1, $text);
return "http://localhost:$port";
+}
+
+=begin private
+
+=head2 setup_listener
+
+We send a signal to the parent here. We need to use NEXT because this is a mixin.
+
+=end private
+
+=cut
+
+sub setup_listener {
+ my $self = shift;
+ $self->NEXT::setup_listener;
+ kill 'USR1', $self->{'test_http_server_simple_parent_pid'};
}
=back
Modified: Test-HTTP-Server-Simple/t/01.basic.t
==============================================================================
--- Test-HTTP-Server-Simple/t/01.basic.t (original)
+++ Test-HTTP-Server-Simple/t/01.basic.t Tue Aug 2 18:23:42 2005
@@ -1,42 +1,30 @@
#!/usr/bin/perl
-use Test::More tests => 11;
+use Test::More tests => 6;
use Test::Builder::Tester;
-BEGIN { use_ok "Test::HTTP::Server::Simple" }
-
-BEGIN { use_ok "HTTP::Server::Simple" }
-
-ok(defined(&started_ok), "function 'started_ok' exported");
-
-test_out("not ok 1 - bar");
-test_fail(+2);
-test_diag("foo is not an HTTP::Server::Simple");
-started_ok("foo", "bar");
-test_test("first arg to started_ok must be an HTTP::Server::Simple");
-
test_out("not ok 1 - baz");
test_fail(+2);
test_diag("HTTP::Server::Simple->background failed: random failure");
-started_ok(THSS::FailOnBackground->new(1234), "baz");
+THSS::FailOnBackground->new(1234)->started_ok("baz");
test_test("detect background failure");
test_out("not ok 1 - blop");
test_fail(+2);
test_diag("HTTP::Server::Simple->background didn't return a valid PID");
-started_ok(THSS::ReturnInvalidPid->new(4194), "blop");
+THSS::ReturnInvalidPid->new(4194)->started_ok("blop");
test_test("detect bad pid");
-BEGIN { use_ok "HTTP::Server::Simple::CGI" }
-
test_out("ok 1 - beep");
-my $URL = started_ok(HTTP::Server::Simple::CGI->new(9583), "beep");
+my $URL = THSS::Good->new(9583)->started_ok("beep");
+test_diag("Waiting for child to start up...");
test_test("start up correctly");
is($URL, "http://localhost:9583");
test_out("ok 1 - started server");
-$URL = started_ok(HTTP::Server::Simple::CGI->new(9384));
+$URL = THSS::Good->new(9384)->started_ok;
+test_diag("Waiting for child to start up...");
test_test("start up correctly (with default message)");
is($URL, "http://localhost:9384");
@@ -47,10 +35,12 @@
package THSS::FailOnBackground;
-use base qw/HTTP::Server::Simple/;
+use base qw/Test::HTTP::Server::Simple HTTP::Server::Simple/;
sub background { die "random failure\n" }
package THSS::ReturnInvalidPid;
-use base qw/HTTP::Server::Simple/;
+use base qw/Test::HTTP::Server::Simple HTTP::Server::Simple/;
sub background { return "" }
+package THSS::Good;
+use base qw/Test::HTTP::Server::Simple HTTP::Server::Simple::CGI/;
More information about the Rt-commit
mailing list