stas 2004/05/29 02:48:43
Modified: t/response/TestAPI uri.pm Log: complete the Apache::URI test Revision Changes Path 1.15 +111 -44 modperl-2.0/t/response/TestAPI/uri.pm Index: uri.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/uri.pm,v retrieving revision 1.14 retrieving revision 1.15 diff -u -u -r1.14 -r1.15 --- uri.pm 19 Jan 2004 15:15:07 -0000 1.14 +++ uri.pm 29 May 2004 09:48:43 -0000 1.15 @@ -7,6 +7,7 @@ use Apache::TestUtil; use Apache::TestRequest; +use APR::Pool (); use APR::URI (); use Apache::URI (); use Apache::RequestRec (); @@ -19,41 +20,99 @@ sub handler { my $r = shift; - plan $r, tests => 15; + plan $r, tests => 22; $r->args('query'); - my $uri = $r->parsed_uri; + # basic + { + my $uri = $r->parsed_uri; - ok $uri->isa('APR::URI'); + ok $uri->isa('APR::URI'); - ok $uri->path =~ m:^$location:; + ok t_cmp(qr/^$location/, $uri->path, "path"); - my $up = $uri->unparse; - ok $up =~ m:^$location:; + my $up = $uri->unparse; + ok t_cmp(qr/^$location/, $up, "unparse"); + } - my $server = $r->construct_server; - ok t_cmp($server, - join(':', $r->get_server_name, $r->get_server_port), - "construct_server/get_server_name/get_server_port"); + # construct_server + { + my $server = $r->construct_server; + ok t_cmp($server, + join(':', $r->get_server_name, $r->get_server_port), + "construct_server/get_server_name/get_server_port"); + } + { + my $hostname = "example.com"; + my $server = $r->construct_server($hostname); + ok t_cmp($server, + join(':', $hostname, $r->get_server_port), + "construct_server($hostname)"); + } + { + my $hostname = "example.com"; + my $port = "9097"; + my $server = $r->construct_server($hostname, $port); + ok t_cmp($server, + join(':', $hostname, $port), + "construct_server($hostname, $port)"); - my $curl = $r->construct_url; - my $parsed = APR::URI->parse($r->pool, $curl); + } + { + my $hostname = "example.com"; + my $port = "9097"; + my $server = $r->construct_server($hostname, $port, $r->pool->new); + ok t_cmp($server, + join(':', $hostname, $port), + "construct_server($hostname, $port, new_pool)"); - ok $parsed->isa('APR::URI'); + } - $up = $parsed->unparse; + # construct_url + { + # if no args are passed then only $r->uri will be included (no + # query and no fragment fields) + my $curl = $r->construct_url; + t_debug("construct_url: $curl"); + t_debug("r->uri: " . $r->uri); + my $parsed = APR::URI->parse($r->pool, $curl); - ok $up =~ m:$location:; + ok $parsed->isa('APR::URI'); - #ok $parsed->query eq $r->args; #XXX? + my $up = $parsed->unparse; + ok t_cmp(qr/$location/, $up, "unparse"); - my $path = '/foo/bar'; + my $path = '/foo/bar'; - $parsed->path($path); + $parsed->path($path); - ok $parsed->path eq $path; + ok t_cmp($path, $parsed->path, "parsed path"); + } + { + # this time include args in the constructed url + my $fragment = "fragment"; + $r->parsed_uri->fragment($fragment); + my $curl = $r->construct_url(sprintf "%s?%s", $r->uri, $r->args); + t_debug("construct_url: $curl"); + t_debug("r->uri: ", $r->uri); + my $parsed = APR::URI->parse($r->pool, $curl); + + my $up = $parsed->unparse; + ok t_cmp(qr/$location/, $up, 'construct_url($uri)'); + ok t_cmp($r->args, $parsed->query, "args vs query"); + } + { + # this time include args and a pool object + my $curl = $r->construct_url(sprintf "%s?%s", $r->uri, $r->args, + $r->pool->new); + t_debug("construct_url: $curl"); + t_debug("r->uri: ", $r->uri); + my $up = APR::URI->parse($r->pool, $curl)->unparse; + ok t_cmp(qr/$location/, $up, 'construct_url($uri, $pool)'); + } + # segfault test { # test the segfault in apr < 0.9.2 (fixed on mod_perl side) # passing only the /path @@ -77,36 +136,44 @@ "but not 'scheme'"); } - my $newr = Apache::RequestRec->new($r->connection, $r->pool); - my $url_string = "$path?query"; - - $newr->parse_uri($url_string); - - ok $newr->uri eq $path; - - ok $newr->args eq 'query'; - - my $puri = $newr->parsed_uri; - - ok $puri->path eq $path; - - ok $puri->query eq 'query'; - - my @c = qw(one two three); - $url_string = join '%20', @c; + # parse_uri + { + my $path = "/foo/bar"; + my $query = "query"; + my $fragment = "fragment"; + my $newr = Apache::RequestRec->new($r->connection, $r->pool); + my $url_string = "$path?$query#$fragment"; + + # new request + $newr->parse_uri($url_string); + ok t_cmp($path, $newr->uri, "uri"); + ok t_cmp($query, $newr->args, "args"); + + my $puri = $newr->parsed_uri; + ok t_cmp($path, $puri->path, "path"); + ok t_cmp($query, $puri->query, "query"); + ok t_cmp($fragment, $puri->fragment, "fragment"); + + my $port = 6767; + $puri->port($port); + $puri->scheme('ftp'); + $puri->hostname('perl.apache.org'); - Apache::URI::unescape_url($url_string); + ok t_cmp($port, $puri->port, "port"); - ok $url_string eq "@c"; + ok t_cmp("ftp://perl.apache.org:$port$path?$query#$fragment", + $puri->unparse, "unparse"); + } - my $port = 6767; - $puri->port($port); - $puri->scheme('ftp'); - $puri->hostname('perl.apache.org'); + # unescape_url + { + my @c = qw(one two three); + my $url_string = join '%20', @c; - ok $puri->port == $port; + Apache::URI::unescape_url($url_string); - ok $puri->unparse eq "ftp://perl.apache.org:$port$path?query"; + ok $url_string eq "@c"; + } Apache::OK; }