Commit | Line | Data |
74fbb9dd |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Config; |
7 | use IO::File; |
8 | use HTTP::Request; |
9 | use HTTP::Request::AsCGI; |
10 | use Test::More; |
11 | |
12 | unless ( $Config{d_fork} ) { |
13 | plan skip_all => 'This test requires a plattform that supports fork()'; |
14 | } |
15 | |
16 | plan tests => 8; |
17 | |
18 | my $response; |
19 | |
20 | { |
21 | my $r = HTTP::Request->new( GET => 'http://www.host.com/' ); |
22 | my $c = HTTP::Request::AsCGI->new($r); |
23 | |
24 | my $kid = fork(); |
25 | |
26 | unless ( defined $kid ) { |
27 | die("Can't fork() kid: $!"); |
28 | } |
29 | |
30 | unless ( $kid ) { |
31 | |
32 | $c->setup; |
33 | |
34 | print "HTTP/1.0 200 OK\n"; |
35 | print "Content-Type: text/plain\n"; |
36 | print "Status: 200\n"; |
37 | print "X-Field: 1\n"; |
38 | print "X-Field: 2\n"; |
39 | print "\n"; |
40 | print "Hello!"; |
41 | |
42 | $c->restore; |
43 | |
44 | exit(0); |
45 | } |
46 | |
47 | waitpid( $kid, 0 ); |
48 | |
49 | $response = $c->response; |
50 | } |
51 | |
52 | isa_ok( $response, 'HTTP::Response' ); |
53 | is( $response->code, 200, 'Response Code' ); |
54 | is( $response->message, 'OK', 'Response Message' ); |
55 | is( $response->protocol, 'HTTP/1.0', 'Response Protocol' ); |
56 | is( $response->content, 'Hello!', 'Response Content' ); |
57 | is( $response->content_length, 6, 'Response Content-Length' ); |
58 | is( $response->content_type, 'text/plain', 'Response Content-Type' ); |
59 | is_deeply( [ $response->header('X-Field') ], [ 1, 2 ], 'Response Header X-Field' ); |