Changeset 17540

Show
Ignore:
Timestamp:
08/12/08 21:34:04 (5 years ago)
Author:
yappo
Message:

refact tests

Location:
lang/perl/HTTP-Engine/trunk/t/010_core
Files:
6 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/HTTP-Engine/trunk/t/010_core/request-absolute_uri.t

    r13758 r17540  
     1use strict; 
     2use warnings; 
    13use Test::Base; 
    24use HTTP::Engine::Request; 

  • lang/perl/HTTP-Engine/trunk/t/010_core/request-readbody.t

    r17502 r17540  
    2020    do {  
    2121        local $@; 
    22         eval { 
    23             $req->raw_body; 
    24         }; 
     22        eval { $req->raw_body }; 
    2523        like $@, qr/read initialization must set input_handle/; 
    2624    }; 
    2725    do {  
    2826        local $@; 
    29         eval { 
    30             $req->request_builder->_io_read; 
    31         }; 
     27        eval { $req->request_builder->_io_read }; 
    3228        like $@, qr/no handle/; 
    3329    }; 
    34  
    35  
    3630}; 
    3731 
    … …  
    5246    ); 
    5347    my $state = $req->_read_state; 
    54     $req->request_builder->_read_all($state); 
    55  
    56     $tmp->seek(0, File::Temp::SEEK_SET); 
    57     $state->{read_position} = 0; 
    58  
    59     do { 
    60         my $read_all = \&HTTP::Engine::RequestBuilder::_read_all; 
    61         no warnings 'redefine'; 
    62         local *HTTP::Engine::RequestBuilder::_read_all = sub { 
    63             $read_all->(@_); 
    64             $state->{read_position}--; 
    65         }; 
    66         local $@; 
    67         eval { $req->request_builder->_read_to_end($state); }; 
    68         like $@, qr/Wrong Content-Length value: 3/; 
     48    my $reset = sub { 
     49        $tmp->seek(0, File::Temp::SEEK_SET); 
     50        $state->{read_position} = 0; 
    6951    }; 
    7052 
    71     $tmp->seek(0, File::Temp::SEEK_SET); 
    72     $state->{read_position} = 0; 
    7353 
    74     do { 
    75         my $read_all = \&HTTP::Engine::RequestBuilder::_read_all; 
    76         no warnings 'redefine'; 
    77         local *HTTP::Engine::RequestBuilder::_read_all = sub { 
    78             $read_all->(@_); 
    79             $state->{read_position}++; 
    80         }; 
    81         local $@; 
    82         eval { $req->request_builder->_read_to_end($state); }; 
    83         like $@, qr/Premature end of request body, -1 bytes remaining/; 
    84     }; 
     54    $req->request_builder->_read_all($state); 
     55    $reset->(); 
    8556 
    86     $tmp->seek(0, File::Temp::SEEK_SET); 
    87     $state->{read_position} = 0; 
     57    read_to_end($req, $state, sub { $state->{read_position}-- }, 'Wrong Content-Length value: 3'); 
     58    $reset->(); 
     59 
     60    read_to_end($req, $state, sub { $state->{read_position}++ }, 'Premature end of request body, -1 bytes remaining'); 
     61    $reset->(); 
    8862 
    8963    do { 
    … …  
    9569    }; 
    9670}; 
     71 
     72sub read_to_end { 
     73    my($req, $state, $code, $re) = @_; 
     74    my $read_all = \&HTTP::Engine::RequestBuilder::_read_all; 
     75    no warnings 'redefine'; 
     76    local *HTTP::Engine::RequestBuilder::_read_all = sub { 
     77        $read_all->(@_); 
     78        $code->(); 
     79    }; 
     80    local $@; 
     81    eval { $req->request_builder->_read_to_end($state); }; 
     82    like $@, qr/\Q$re\E/, $re; 
     83} 

  • lang/perl/HTTP-Engine/trunk/t/010_core/request-secure.t

    r17480 r17540  
    11use strict; 
    22use warnings; 
    3 use Test::More; 
     3use Test::Base; 
    44use HTTP::Engine::Request; 
    55use HTTP::Engine::RequestBuilder; 
    66 
    7 plan tests => 18; 
     7plan tests => 3*blocks; 
    88 
    9 $ENV{HTTP_HOST} = 'example.com'; 
    10  
    11 do { 
    12     local $ENV{HTTPS} = 'ON'; 
    13     check(1, 'https://example.com/', 443); 
    14 }; 
    15  
    16 do { 
    17     local $ENV{HTTPS} = 'OFF'; 
    18     check(0, 'http://example.com/', 80); 
    19 }; 
    20  
    21 do { 
    22     check(0, 'http://example.com/', 80); 
    23 }; 
    24  
    25 do { 
    26     local $ENV{HTTPS} = 'ON'; 
    27     local $ENV{SERVER_PORT} = 8443; 
    28     check(1, 'https://example.com:8443/', 8443); 
    29 }; 
    30  
    31 do { 
    32     local $ENV{SERVER_PORT} = 443; 
    33     check(1, 'https://example.com/', 443); 
    34 }; 
    35  
    36 do { 
    37     local $ENV{SERVER_PORT} = 80; 
    38     check(0, 'http://example.com/', 80); 
    39 }; 
    40  
    41 sub check { 
    42     my($is_secure, $uri, $port) = @_; 
     9filters { env  => ['yaml'] }; 
     10run { 
     11    my $block = shift; 
    4312    my $req = HTTP::Engine::Request->new( 
    4413        request_builder => HTTP::Engine::RequestBuilder->new, 
    4514    ); 
    46     is $req->secure   , $is_secure; 
    47     is $req->uri      , $uri; 
    48     is $req->uri->port, $port; 
     15    local %ENV = %{ $block->env }; 
     16    my $secure = $req->secure; 
     17    is qq{"$secure"}  , $block->is_secure; 
     18    is $req->uri      , $block->uri; 
     19    is $req->uri->port, $block->port; 
    4920} 
    5021 
     22__END__ 
     23 
     24=== 
     25--- env 
     26  HTTP_HOST: example.com 
     27  HTTPS: ON 
     28--- is_secure: "1" 
     29--- uri: https://example.com/ 
     30--- port: 443 
     31 
     32=== 
     33--- env 
     34  HTTP_HOST: example.com 
     35  HTTPS: OFF 
     36--- is_secure: "0" 
     37--- uri: http://example.com/ 
     38--- port: 80 
     39 
     40=== 
     41--- env 
     42  HTTP_HOST: example.com 
     43--- is_secure: "0" 
     44--- uri: http://example.com/ 
     45--- port: 80 
     46 
     47=== 
     48--- env 
     49  HTTP_HOST: example.com 
     50  HTTPS: ON 
     51  SERVER_PORT: 8443 
     52--- is_secure: "1" 
     53--- uri: https://example.com:8443/ 
     54--- port: 8443 
     55 
     56=== 
     57--- env 
     58  HTTP_HOST: example.com 
     59  SERVER_PORT: 443  
     60--- is_secure: "1" 
     61--- uri: https://example.com/ 
     62--- port: 443 
     63 
     64=== 
     65--- env 
     66  HTTP_HOST: example.com 
     67  SERVER_PORT: 80 
     68--- is_secure: "0" 
     69--- uri: http://example.com/ 
     70--- port: 80 

  • lang/perl/HTTP-Engine/trunk/t/010_core/request_builder_dummy.t

    r17293 r17540  
    99is (HTTP::Engine::RequestBuilder::Dummy->_build_raw_body, ''); 
    1010 
    11 local $@; 
    12 eval { HTTP::Engine::RequestBuilder::Dummy->_build_http_body }; 
    13 like $@, qr/^HTTP::Body not supported with dummy request builder/; 
     11do { 
     12    local $@; 
     13    eval { HTTP::Engine::RequestBuilder::Dummy->_build_http_body }; 
     14    like $@, qr/^HTTP::Body not supported with dummy request builder/; 
     15}; 
    1416 
    15 local $@; 
    16 eval { HTTP::Engine::RequestBuilder::Dummy->_build_read_state }; 
    17 like $@, qr/^Dummy request has no read state, can't parse HTTP::Body/; 
     17do { 
     18    local $@; 
     19    eval { HTTP::Engine::RequestBuilder::Dummy->_build_read_state }; 
     20    like $@, qr/^Dummy request has no read state, can't parse HTTP::Body/; 
     21}; 
    1822 
    1923is_deeply (HTTP::Engine::RequestBuilder::Dummy->_build_connection_info, {}); 

  • lang/perl/HTTP-Engine/trunk/t/010_core/response-cookie.t

    r17446 r17540  
    1111        my $res = HTTP::Engine::Response->new(); 
    1212        $res->cookies({ 
    13             'Foo' => CGI::Simple::Cookie->new( 
     13            Foo => CGI::Simple::Cookie->new( 
    1414                -name    => 'Foo', 
    1515                -value   => 'foo', 
    … …  
    2626                secure => 1, 
    2727            }, 
    28             'ID' => CGI::Simple::Cookie->new( 
     28            ID => CGI::Simple::Cookie->new( 
    2929                -name    => 'ID', 
    3030                -value   => 'TKSK', 

  • lang/perl/HTTP-Engine/trunk/t/010_core/responsewriter-with_io.t

    r17526 r17540  
    3131__END__ 
    3232 
    33 === 
     33=== normal io 
    3434--- input 
    3535my $writer = HTTP::Engine::ResponseWriter->new( 
    … …  
    6464OK! 
    6565 
    66 === 
     66=== dummy io 
    6767--- input 
    6868my $writer = HTTP::Engine::ResponseWriter->new( 
    … …  
    9494bless 
    9595 
    96 === 
     96=== big size 
    9797--- input 
    9898my $writer = HTTP::Engine::ResponseWriter->new( 
    … …  
    130130".('dummy'x5000) 
    131131 
    132 === 
     132=== no io 
    133133--- input 
    134134my $writer = HTTP::Engine::ResponseWriter->new( 
    … …  
    159159OK! 
    160160 
    161 === 
     161=== broken writer 
    162162--- input 
    163163my $writer = HTTP::Engine::ResponseWriter->new(