From: Christian Hansen Date: Sat, 29 Oct 2005 16:08:31 +0000 (+0000) Subject: Added a forking test X-Git-Tag: v1.0~40 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FHTTP-Request-AsCGI.git;a=commitdiff_plain;h=74fbb9dd08089803ba7775e8a4aaee36481020da Added a forking test --- diff --git a/lib/HTTP/Request/AsCGI.pm b/lib/HTTP/Request/AsCGI.pm index 226420c..cd7394f 100644 --- a/lib/HTTP/Request/AsCGI.pm +++ b/lib/HTTP/Request/AsCGI.pm @@ -140,9 +140,7 @@ sub setup { sub response { my ( $self, $callback ) = @_; - return undef unless $self->{setuped}; - return undef unless $self->{restored}; - return undef unless $self->{restore}->{stdout}; + return undef unless $self->stdout; require HTTP::Response; @@ -344,6 +342,18 @@ handle with an file descriptor. =back +=head1 SEE ALSO + +=over 4 + +=item examples directory in this distribution. + +=item L + +=item L + +=back + =head1 THANKS TO Thomas L. Shinnick for his valuable win32 testing. diff --git a/t/05env.t b/t/05env.t index e77ed92..209d61e 100644 --- a/t/05env.t +++ b/t/05env.t @@ -5,7 +5,6 @@ use Test::More tests => 10; use strict; use warnings; -use IO::File; use HTTP::Request; use HTTP::Request::AsCGI; diff --git a/t/07forking.t b/t/07forking.t new file mode 100644 index 0000000..c4f0463 --- /dev/null +++ b/t/07forking.t @@ -0,0 +1,59 @@ +#!perl + +use strict; +use warnings; + +use Config; +use IO::File; +use HTTP::Request; +use HTTP::Request::AsCGI; +use Test::More; + +unless ( $Config{d_fork} ) { + plan skip_all => 'This test requires a plattform that supports fork()'; +} + +plan tests => 8; + +my $response; + +{ + my $r = HTTP::Request->new( GET => 'http://www.host.com/' ); + my $c = HTTP::Request::AsCGI->new($r); + + my $kid = fork(); + + unless ( defined $kid ) { + die("Can't fork() kid: $!"); + } + + unless ( $kid ) { + + $c->setup; + + print "HTTP/1.0 200 OK\n"; + print "Content-Type: text/plain\n"; + print "Status: 200\n"; + print "X-Field: 1\n"; + print "X-Field: 2\n"; + print "\n"; + print "Hello!"; + + $c->restore; + + exit(0); + } + + waitpid( $kid, 0 ); + + $response = $c->response; +} + +isa_ok( $response, 'HTTP::Response' ); +is( $response->code, 200, 'Response Code' ); +is( $response->message, 'OK', 'Response Message' ); +is( $response->protocol, 'HTTP/1.0', 'Response Protocol' ); +is( $response->content, 'Hello!', 'Response Content' ); +is( $response->content_length, 6, 'Response Content-Length' ); +is( $response->content_type, 'text/plain', 'Response Content-Type' ); +is_deeply( [ $response->header('X-Field') ], [ 1, 2 ], 'Response Header X-Field' );