#!/local/bin/perl -w

use Catalyst::SmartURI '-import_uri_mods';
use Catalyst::SmartURI::URL qw(url);
use Catalyst::SmartURI::Escape qw(uri_escape uri_unescape);

# want compatiblity
use Catalyst::SmartURI::file;
$URI::file::DEFAULT_AUTHORITY = undef;

# _expect()
#
# Handy low-level object method tester which we insert as a method
# in the URI::URL class
#
sub URI::URL::_expect {
    my($self, $method, $expect, @args) = @_;
    my $result = $self->$method(@args);
    $expect = 'UNDEF' unless defined $expect;
    $result = 'UNDEF' unless defined $result;
    return 1 if $expect eq $result;
    warn "'$self'->$method(@args) = '$result' " .
		"(expected '$expect')\n";
    $self->print_on('STDERR');
    die "Test Failed";
}

package main;

# Must ensure that there is no relative paths in @INC because we will
# chdir in the newlocal tests.
unless ($^O eq "MacOS") {
chomp($pwd = ($^O =~ /mswin32/i ? `cd` : $^O eq 'VMS' ? `show default` : `pwd`));
if ($^O eq 'VMS') {
    $pwd =~ s#^\s+##;
    $pwd = VMS::Filespec::unixpath($pwd);
    $pwd =~ s#/$##;
}
for (@INC) {
    my $x = $_;
    $x = VMS::Filespec::unixpath($x) if $^O eq 'VMS';
    next if $x =~ m|^/| or $^O =~ /os2|mswin32/i
	and $x =~ m#^(\w:[\\/]|[\\/]{2})#;
    next if $x =~ /CODE\(/;
    print "Turn lib path $x into $pwd/$x\n";
    $_ = "$pwd/$x";

}
}

$| = 1;

print "1..8\n";  # for Test::Harness

# Do basic tests first.
# Dies if an error has been detected, prints "ok" otherwise.

print "Self tests for URI::URL version $URI::URL::VERSION...\n";

eval { scheme_parse_test(); };
print "not " if $@;
print "ok 1\n";

eval { parts_test(); };
print "not " if $@;
print "ok 2\n";

eval { escape_test(); };
print "not " if $@;
print "ok 3\n";

eval { newlocal_test(); };
print "not " if $@;
print "ok 4\n";

eval { absolute_test(); };
print "not " if $@;
print "ok 5\n";

eval { eq_test(); };
print "not " if $@;
print "ok 6\n";

# Let's test making our own things
URI::URL::strict(0);
# This should work after URI::URL::strict(0)
$url = new Catalyst::SmartURI::URL "x-myscheme:something";
# Since no implementor is registered for 'x-myscheme' then it will
# be handled by the URI::URL::_generic class
$url->_expect('as_string' => 'x-myscheme:something');
$url->_expect('path' => 'something');
URI::URL::strict(1);

=comment

# Let's try to make our URL subclass
{
    package MyURL;
    @ISA = URI::URL::implementor();

    sub _parse {
	my($self, $init) = @_;
	$self->URI::URL::_generic::_parse($init, qw(netloc path));
    }

    sub foo {
	my $self = shift;
	print ref($self)."->foo called for $self\n";
    }
}
# Let's say that it implements the 'x-a+b.c' scheme (alias 'x-foo')
URI::URL::implementor('x-a+b.c', 'MyURL');
URI::URL::implementor('x-foo', 'MyURL');

# Now we are ready to try our new URL scheme
$url = new Catalyst::SmartURI::URL 'x-a+b.c://foo/bar;a?b';
$url->_expect('as_string', 'x-a+b.c://foo/bar;a?b');
$url->_expect('path', '/bar;a?b');
$url->foo;
$newurl = new Catalyst::SmartURI::URL 'xxx', $url;
$newurl->foo;
$url = new Catalyst::SmartURI::URL 'yyy', 'x-foo:';
$url->foo;

=cut

print "ok 7\n";

# Test the new wash&go constructor
print "not " if url("../foo.html", "http://www.sn.no/a/b")->abs->as_string
		ne 'http://www.sn.no/foo.html';
print "ok 8\n";

print "URI::URL version $URI::URL::VERSION ok\n";

exit 0;




#####################################################################
#
# scheme_parse_test()
#
# test parsing and retrieval methods

sub scheme_parse_test {

    print "scheme_parse_test:\n";

    $tests = {
	'hTTp://web1.net/a/b/c/welcome#intro'
	=> {    'scheme'=>'http', 'host'=>'web1.net', 'port'=>80,
		'path'=>'/a/b/c/welcome', 'frag'=>'intro','query'=>undef,
		'epath'=>'/a/b/c/welcome', 'equery'=>undef,
		'params'=>undef, 'eparams'=>undef,
		'as_string'=>'http://web1.net/a/b/c/welcome#intro',
		'full_path' => '/a/b/c/welcome' },

	'http://web:1/a?query+text'
	=> {    'scheme'=>'http', 'host'=>'web', 'port'=>1,
		'path'=>'/a', 'frag'=>undef, 'query'=>'query+text' },

	'http://web.net/'
	=> {    'scheme'=>'http', 'host'=>'web.net', 'port'=>80,
		'path'=>'/', 'frag'=>undef, 'query'=>undef,
		'full_path' => '/',
		'as_string' => 'http://web.net/' },

	'http://web.net'
	=> {    'scheme'=>'http', 'host'=>'web.net', 'port'=>80,
		'path'=>'/', 'frag'=>undef, 'query'=>undef,
		'full_path' => '/',
		'as_string' => 'http://web.net/' },

	'http:0'
	 => {   'scheme'=>'http', 'path'=>'0', 'query'=>undef,
		'as_string'=>'http:0', 'full_path'=>'0', },

	'http:/0?0'
	 => {   'scheme'=>'http', 'path'=>'/0', 'query'=>'0',
		'as_string'=>'http:/0?0', 'full_path'=>'/0?0', },

	'http://0:0/0/0;0?0#0'
	 => {   'scheme'=>'http', 'host'=>'0', 'port'=>'0',
		'path' => '/0/0', 'query'=>'0', 'params'=>'0',
		'netloc'=>'0:0',
		'frag'=>0, 'as_string'=>'http://0:0/0/0;0?0#0' },

	'ftp://0%3A:%40@h:0/0?0'
	=>  {   'scheme'=>'ftp', 'user'=>'0:', 'password'=>'@',
		'host'=>'h', 'port'=>'0', 'path'=>'/0?0',
		'query'=>'0', params=>undef,
		'netloc'=>'0%3A:%40@h:0',
		'as_string'=>'ftp://0%3A:%40@h:0/0?0' },

	'ftp://usr:pswd@web:1234/a/b;type=i'
	=> {    'host'=>'web', 'port'=>1234, 'path'=>'/a/b',
		'user'=>'usr', 'password'=>'pswd',
		'params'=>'type=i',
		'as_string'=>'ftp://usr:pswd@web:1234/a/b;type=i' },

	'ftp://host/a/b'
	=> {    'host'=>'host', 'port'=>21, 'path'=>'/a/b',
		'user'=>'anonymous',
		'as_string'=>'ftp://host/a/b' },

	'file://host/fseg/fs?g/fseg'
	# don't escape ? for file: scheme
	=> {    'host'=>'host', 'path'=>'/fseg/fs?g/fseg',
		'as_string'=>'file://host/fseg/fs?g/fseg' },

	'gopher://host'
	=> {     'gtype'=>'1', 'as_string' => 'gopher://host', },

	'gopher://host/'
	=> {     'gtype'=>'1', 'as_string' => 'gopher://host/', },

	'gopher://gopher/2a_selector'
	=> {    'gtype'=>'2', 'selector'=>'a_selector',
		'as_string' => 'gopher://gopher/2a_selector', },

	'mailto:libwww-perl@ics.uci.edu'
	=> {    'address'       => 'libwww-perl@ics.uci.edu',
		'encoded822addr'=> 'libwww-perl@ics.uci.edu',
#		'user'          => 'libwww-perl',
#		'host'          => 'ics.uci.edu',
		'as_string'     => 'mailto:libwww-perl@ics.uci.edu', },

	'news:*'
	=> {    'groupart'=>'*', 'group'=>'*', as_string=>'news:*' },
	'news:comp.lang.perl'
	=> {    'group'=>'comp.lang.perl' },
	'news:perl-faq/module-list-1-794455075@ig.co.uk'
	=> {    'article'=>
		    'perl-faq/module-list-1-794455075@ig.co.uk' },

	'nntp://news.com/comp.lang.perl/42'
	=> {    'group'=>'comp.lang.perl', }, #'digits'=>42 },

	'telnet://usr:pswd@web:12345/'
	=> {    'user'=>'usr', 'password'=>'pswd', 'host'=>'web' },
	'rlogin://aas@a.sn.no'
	=> {    'user'=>'aas', 'host'=>'a.sn.no' },
#	'tn3270://aas@ibm'
#	=> {    'user'=>'aas', 'host'=>'ibm',
#		'as_string'=>'tn3270://aas@ibm/'},

#	'wais://web.net/db'
#	=> { 'database'=>'db' },
#	'wais://web.net/db?query'
#	=> { 'database'=>'db', 'query'=>'query' },
#	'wais://usr:pswd@web.net/db/wt/wp'
#	=> {    'database'=>'db', 'wtype'=>'wt', 'wpath'=>'wp',
#		'password'=>'pswd' },
    };

    foreach $url_str (sort keys %$tests ){
	print "Testing '$url_str'\n";
	my $url = new Catalyst::SmartURI::URL $url_str;
	my $tests = $tests->{$url_str};
	while( ($method, $exp) = each %$tests ){
	    $exp = 'UNDEF' unless defined $exp;
	    $url->_expect($method, $exp);
	}
    }
}


#####################################################################
#
# parts_test()          (calls netloc_test test)
#
# Test individual component part access functions
#
sub parts_test {
    print "parts_test:\n";

    # test storage part access/edit methods (netloc, user, password,
    # host and port are tested by &netloc_test)

    $url = new Catalyst::SmartURI::URL 'file://web/orig/path';

    $url->scheme('http');
    $url->path('1info');
    $url->query('key words');
    $url->frag('this');
    $url->_expect('as_string' => 'http://web/1info?key%20words#this');

    $url->epath('%2f/%2f');
    $url->equery('a=%26');
    $url->_expect('full_path' => '/%2f/%2f?a=%26');

    # At this point it should be impossible to access the members path()
    # and query() without complaints.
    eval { my $p = $url->path; print "Path is $p\n"; };
    die "Path exception failed" unless $@;
    eval { my $p = $url->query; print "Query is $p\n"; };
    die "Query exception failed" unless $@;

    # but we should still be able to set it 
    $url->path("howdy");
    $url->_expect('as_string' => 'http://web/howdy?a=%26#this');

    # Test the path_components function
    $url = new URI::URL 'file:%2f/%2f';
    my $p;
    $p = join('-', $url->path_components);
    die "\$url->path_components returns '$p', expected '/-/'"
      unless $p eq "/-/";
    $url->host("localhost");
    $p = join('-', $url->path_components);
    die "\$url->path_components returns '$p', expected '-/-/'"
      unless $p eq "-/-/";
    $url->epath("/foo/bar/");
    $p = join('-', $url->path_components);
    die "\$url->path_components returns '$p', expected '-foo-bar-'"
      unless $p eq "-foo-bar-";
    $url->path_components("", "/etc", "\0", "..", "øse", "");
    $url->_expect('full_path' => '/%2Fetc/%00/../%F8se/');

    # Setting undef
    $url = new URI::URL 'http://web/p;p?q#f';
    $url->epath(undef);
    $url->equery(undef);
    $url->eparams(undef);
    $url->frag(undef);
    $url->_expect('as_string' => 'http://web');

    # Test http query access methods
    $url->keywords('dog');
    $url->_expect('as_string' => 'http://web?dog');
    $url->keywords(qw(dog bones));
    $url->_expect('as_string' => 'http://web?dog+bones');
    $url->keywords(0,0);
    $url->_expect('as_string' => 'http://web?0+0');
    $url->keywords('dog', 'bones', '#+=');
    $url->_expect('as_string' => 'http://web?dog+bones+%23%2B%3D');
    $a = join(":", $url->keywords);
    die "\$url->keywords did not work (returned '$a')" unless $a eq 'dog:bones:#+=';
    # calling query_form is an error
#    eval { my $foo = $url->query_form; };
#    die "\$url->query_form should croak since query contains keywords not a form."
#      unless $@;

    $url->query_form(a => 'foo', b => 'bar');
    $url->_expect('as_string' => 'http://web?a=foo&b=bar');
    my %a = $url->query_form;
    die "\$url->query_form did not work"
      unless $a{a} eq 'foo' && $a{b} eq 'bar';

    $url->query_form(a => undef, a => 'foo', '&=' => '&=+');
    $url->_expect('as_string' => 'http://web?a=&a=foo&%26%3D=%26%3D%2B');

    my @a = $url->query_form;
    die "Wrong length" unless @a == 6;
    die "Bad keys from query_form"
      unless $a[0] eq 'a' && $a[2] eq 'a' && $a[4] eq '&=';
    die "Bad values from query_form"
      unless $a[1] eq '' && $a[3] eq 'foo' && $a[5] eq '&=+';

    # calling keywords is an error
#    eval { my $foo = $url->keywords; };
#    die "\$url->keywords should croak when query is a form"
#      unless $@;
    # Try this odd one
    $url->equery('&=&=b&a=&a&a=b=c&&a=b');
    @a = $url->query_form;
    #print join(":", @a), "\n";
    die "Wrong length" unless @a == 16;
    die "Wrong sequence" unless $a[4]  eq ""  && $a[5]  eq "b" &&
                                $a[10] eq "a" && $a[11] eq "b=c";

    # Try array ref values in the key value pairs
    $url->query_form(a => ['foo', 'bar'], b => 'foo', c => ['bar', 'foo']);
    $url->_expect('as_string', 'http://web?a=foo&a=bar&b=foo&c=bar&c=foo');


    netloc_test();
    port_test();

    $url->query(undef);
    $url->_expect('query', undef);

    $url = new URI::URL 'gopher://gopher/';
    $url->port(33);
    $url->gtype("3");
    $url->selector("S");
    $url->search("query");
    $url->_expect('as_string', 'gopher://gopher:33/3S%09query');

    $url->epath("45%09a");
    $url->_expect('gtype' => '4');
    $url->_expect('selector' => '5');
    $url->_expect('search' => 'a');
    $url->_expect('string' => undef);
    $url->_expect('path' => "/45\ta");
#    $url->path("00\t%09gisle");
#    $url->_expect('search', '%09gisle');

    # Let's test som other URL schemes
    $url = new URI::URL 'news:';
    $url->group("comp.lang.perl.misc");
    $url->_expect('as_string' => 'news:comp.lang.perl.misc');
    $url->article('<1234@a.sn.no>');
    $url->_expect('as_string' => 'news:1234@a.sn.no'); # "<" and ">" are gone
    # This one should be illegal
    eval { $url->article("no.perl"); };
    die "This one should really complain" unless $@;

#    $url = new URI::URL 'mailto:';
#    $url->user("aas");
#    $url->host("a.sn.no");
#    $url->_expect("as_string" => 'mailto:aas@a.sn.no');
#    $url->address('foo@bar');
#    $url->_expect("host" => 'bar');
#    $url->_expect("user" => 'foo');

#    $url = new URI::URL 'wais://host/database/wt/wpath';
#    $url->database('foo');
#    $url->_expect('as_string' => 'wais://host/foo/wt/wpath');
#    $url->wtype('bar');
#    $url->_expect('as_string' => 'wais://host/foo/bar/wpath');

    # Test crack method for various URLs
    my(@crack, $crack);
    @crack = URI::URL->new("http://host/path;param?query#frag")->crack;
    die "Cracked result should be 9 elements" unless @crack == 9;
    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
    print "Cracked result: $crack\n";
    die "Bad crack result" unless
      $crack eq "http*UNDEF*UNDEF*host*80*/path*param*query*frag";

    @crack = URI::URL->new("foo/bar", "ftp://aas\@ftp.sn.no/")->crack;
    die "Cracked result should be 9 elements" unless @crack == 9;
    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
    print "Cracked result: $crack\n";
#    die "Bad crack result" unless
#      $crack eq "ftp*UNDEF*UNDEF*UNDEF*21*foo/bar*UNDEF*UNDEF*UNDEF";

    @crack = URI::URL->new('ftp://u:p@host/q?path')->crack;
    die "Cracked result should be 9 elements" unless @crack == 9;
    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
    print "Cracked result: $crack\n";
    die "Bad crack result" unless
      $crack eq "ftp*u*p*host*21*/q?path*UNDEF*path*UNDEF";

    @crack = URI::URL->new("ftp://ftp.sn.no/pub")->crack;    # Test anon ftp
    die "Cracked result should be 9 elements" unless @crack == 9;
    die "No passwd in anonymous crack" unless $crack[2];
    $crack[2] = 'passwd';  # easier to test when we know what it is
    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
    print "Cracked result: $crack\n";
    die "Bad crack result" unless
      $crack eq "ftp*anonymous*passwd*ftp.sn.no*21*/pub*UNDEF*UNDEF*UNDEF";

    @crack = URI::URL->new('mailto:aas@sn.no')->crack;
    die "Cracked result should be 9 elements" unless @crack == 9;
    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
    print "Cracked result: $crack\n";
#    die "Bad crack result" unless
#      $crack eq "mailto*aas*UNDEF*sn.no*UNDEF*aas\@sn.no*UNDEF*UNDEF*UNDEF";

    @crack = URI::URL->new('news:comp.lang.perl.misc')->crack;
    die "Cracked result should be 9 elements" unless @crack == 9;
    $crack = join("*", map { defined($_) ? $_ : "UNDEF" } @crack);
    print "Cracked result: $crack\n";
    die "Bad crack result" unless
      $crack eq "news*UNDEF*UNDEF*UNDEF*119*comp.lang.perl.misc*UNDEF*UNDEF*UNDEF";
}

#
# netloc_test()
#
# Test automatic netloc synchronisation
#
sub netloc_test {
    print "netloc_test:\n";

    my $url = new Catalyst::SmartURI::URL 'ftp://anonymous:p%61ss@håst:12345';
    $url->_expect('user', 'anonymous');
    $url->_expect('password', 'pass');
    $url->_expect('host', 'håst');
    $url->_expect('port', 12345);
    # Can't really know how netloc is represented since it is partially escaped
    #$url->_expect('netloc', 'anonymous:pass@hst:12345');
    $url->_expect('as_string' => 'ftp://anonymous:pass@h%E5st:12345');

    # The '0' is sometimes tricky to get right
    $url->user(0);
    $url->password(0);
    $url->host(0);
    $url->port(0);
    $url->_expect('netloc' => '0:0@0:0');
    $url->host(undef);
    $url->_expect('netloc' => '0:0@:0');
    $url->host('h');
    $url->user(undef);
    $url->_expect('netloc' => ':0@h:0');
    $url->user('');
    $url->_expect('netloc' => ':0@h:0');
    $url->password('');
    $url->_expect('netloc' => ':@h:0');
    $url->user('foo');
    $url->_expect('netloc' => 'foo:@h:0');

    # Let's try a simple one
    $url->user('nemo');
    $url->password('p2');
    $url->host('hst2');
    $url->port(2);
    $url->_expect('netloc' => 'nemo:p2@hst2:2');

    $url->user(undef);
    $url->password(undef);
    $url->port(undef);
    $url->_expect('netloc' => 'hst2');
    $url->_expect('port' => '21');  # the default ftp port

    $url->port(21);
    $url->_expect('netloc' => 'hst2:21');

    # Let's try some reserved chars
    $url->user("@");
    $url->password(":-#-;-/-?");
    $url->_expect('as_string' => 'ftp://%40::-%23-;-%2F-%3F@hst2:21');

}

#
# port_test()
#
# Test port behaviour
#
sub port_test {
    print "port_test:\n";

    $url = Catalyst::SmartURI::URL->new('http://foo/root/dir/');
    my $port = $url->port;
    die "Port undefined" unless defined $port;
    die "Wrong port $port" unless $port == 80;
    die "Wrong string" unless $url->as_string eq
	'http://foo/root/dir/';

    $url->port(8001);
    $port = $url->port;
    die "Port undefined" unless defined $port;
    die "Wrong port $port" unless $port == 8001;
    die "Wrong string" unless $url->as_string eq
	'http://foo:8001/root/dir/';

    $url->port(80);
    $port = $url->port;
    die "Port undefined" unless defined $port;
    die "Wrong port $port" unless $port == 80;
    die "Wrong string" unless $url->canonical->as_string eq
	'http://foo/root/dir/';

    $url->port(8001);
    $url->port(undef);
    $port = $url->port;
    die "Port undefined" unless defined $port;
    die "Wrong port $port" unless $port == 80;
    die "Wrong string" unless $url->as_string eq
	'http://foo/root/dir/';
}


#####################################################################
#
# escape_test()
#
# escaping functions

sub escape_test {
    print "escape_test:\n";

    # supply escaped URL
    $url = new Catalyst::SmartURI::URL 'http://web/this%20has%20spaces';
    # check component is unescaped
    $url->_expect('path', '/this has spaces');

    # modify the unescaped form
    $url->path('this ALSO has spaces');
    # check whole url is escaped
    $url->_expect('as_string',
		  'http://web/this%20ALSO%20has%20spaces');

    $url = new Catalyst::SmartURI::URL uri_escape('http://web/try %?#" those');
    $url->_expect('as_string',
		  'http%3A%2F%2Fweb%2Ftry%20%25%3F%23%22%20those');

    my $all = pack('C*',0..255);
    my $esc = uri_escape($all);
    my $new = uri_unescape($esc);
    die "uri_escape->uri_unescape mismatch" unless $all eq $new;

    $url->path($all);
    $url->_expect('full_path' => q(%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F%20!%22%23$%&'()*+,-./0123456789:;%3C=%3E%3F@ABCDEFGHIJKLMNOPQRSTUVWXYZ[%5C]%5E_%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D~%7F%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF));

    # test escaping uses uppercase (preferred by rfc1837)
    $url = new Catalyst::SmartURI::URL 'file://h/';
    $url->path(chr(0x7F));
    $url->_expect('as_string', 'file://h/%7F');

    return;
    # reserved characters differ per scheme

    ## XXX is this '?' allowed to be unescaped
    $url = new Catalyst::SmartURI::URL 'file://h/test?ing';
    $url->_expect('path', '/test?ing');

    $url = new Catalyst::SmartURI::URL 'file://h/';
    $url->epath('question?mark');
    $url->_expect('as_string', 'file://h/question?mark');
    # XXX Why should this be any different???
    #     Perhaps we should not expect too much :-)
    $url->path('question?mark');
    $url->_expect('as_string', 'file://h/question%3Fmark');

    # See what happens when set different elements to this ugly sting
    my $reserved = ';/?:@&=#%';
    $url->path($reserved . "foo");
    $url->_expect('as_string', 'file://h/%3B/%3F%3A%40%26%3D%23%25foo');

    $url->scheme('http');
    $url->path('');
    $url->_expect('as_string', 'http://h/');
    $url->query($reserved);
    $url->params($reserved);
    $url->frag($reserved);
    $url->_expect('as_string', 'http://h/;%3B%2F%3F%3A%40&=%23%25?%3B%2F%3F%3A%40&=%23%25#;/?:@&=#%');

    $str = $url->as_string;
    $url = new Catalyst::SmartURI::URL $str;
    die "URL changed" if $str ne $url->as_string;

    $url = new Catalyst::SmartURI::URL 'ftp:foo';
    $url->user($reserved);
    $url->host($reserved);
    $url->_expect('as_string', 'ftp://%3B%2F%3F%3A%40%26%3D%23%25@%3B%2F%3F%3A%40%26%3D%23%25/foo');

}


#####################################################################
#
# newlocal_test()
#

sub newlocal_test {
    return 1 if $^O eq "MacOS";

    print "newlocal_test:\n";
    my $isMSWin32 = ($^O =~ /MSWin32/i);
    my $pwd = ($isMSWin32 ? 'cd' :
	      ($^O eq 'qnx' ? '/usr/bin/fullpath -t' :
              ($^O eq 'VMS' ? 'show default' :
              (-e '/bin/pwd' ? '/bin/pwd' : 'pwd'))));
    my $tmpdir = ($^O eq 'MSWin32' ? $ENV{TEMP} : '/tmp');
    if ( $^O eq 'qnx' ) {
	$tmpdir = `/usr/bin/fullpath -t $tmpdir`;
	chomp $tmpdir;
    }
    $tmpdir = '/sys$scratch' if $^O eq 'VMS';
    $tmpdir =~ tr|\\|/|;

    my $savedir = `$pwd`;     # we don't use Cwd.pm because we want to check
			      # that it get require'd correctly by URL.pm
    chomp $savedir;
    if ($^O eq 'VMS') {
        $savedir =~ s#^\s+##;
        $savedir = VMS::Filespec::unixpath($savedir);
        $savedir =~ s#/$##;
    }

    # cwd
    chdir($tmpdir) or die $!;
    my $dir = `$pwd`; $dir =~ tr|\\|/|;
    chomp $dir;
    if ($^O eq 'VMS') {
        $dir =~ s#^\s+##;
        $dir = VMS::Filespec::unixpath($dir);
        $dir =~ s#/$##;
    }
    $dir = uri_escape($dir, ':');
    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
    $url = newlocal Catalyst::SmartURI::URL;
    my $ss = $isMSWin32 ? '//' : (($dir =~ m,^/,) ? '' : '///' );
    $url->_expect('as_string', Catalyst::SmartURI::URL->new("file:$ss$dir/")->as_string);

    print "Local directory is ". $url->local_path . "\n";

    if ($^O ne 'VMS') {
    # absolute dir
    chdir('/') or die $!;
    $url = newlocal Catalyst::SmartURI::URL '/usr/';
    $url->_expect('as_string', 'file:/usr/');

    # absolute file
    $url = newlocal Catalyst::SmartURI::URL '/vmunix';
    $url->_expect('as_string', 'file:/vmunix');
    }

    # relative file
    chdir($tmpdir) or die $!;
    $dir = `$pwd`; $dir =~ tr|\\|/|;
    chomp $dir;
    if ($^O eq 'VMS') {
        $dir =~ s#^\s+##;
        $dir = VMS::Filespec::unixpath($dir);
        $dir =~ s#/$##;
    }
    $dir = uri_escape($dir, ':');
    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
    $url = newlocal Catalyst::SmartURI::URL 'foo';
    $url->_expect('as_string', "file:$ss$dir/foo");

    # relative dir
    chdir($tmpdir) or die $!;
    $dir = `$pwd`; $dir =~ tr|\\|/|;
    chomp $dir;
    if ($^O eq 'VMS') {
        $dir =~ s#^\s+##;
        $dir = VMS::Filespec::unixpath($dir);
        $dir =~ s#/$##;
    }
    $dir = uri_escape($dir, ':');
    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
    $url = newlocal Catalyst::SmartURI::URL 'bar/';
    $url->_expect('as_string', "file:$ss$dir/bar/");

    # 0
    if ($^O ne 'VMS') {
    chdir('/') or die $!;
    $dir = `$pwd`; $dir =~ tr|\\|/|;
        chomp $dir;
        $dir = uri_escape($dir, ':');
    $dir =~ s/^(\w)%3A/$1:/ if $isMSWin32 or $^O eq 'os2';
    $url = newlocal Catalyst::SmartURI::URL '0';
    $url->_expect('as_string', "file:$ss${dir}0");
    }

    # Test access methods for file URLs
    $url = new Catalyst::SmartURI::URL 'file:/c:/dos';
    $url->_expect('dos_path', 'C:\\DOS');
    $url->_expect('unix_path', '/c:/dos');
    #$url->_expect('vms_path', '[C:]DOS');
    $url->_expect('mac_path',  'UNDEF');

    $url = new Catalyst::SmartURI::URL 'file:/foo/bar';
    $url->_expect('unix_path', '/foo/bar');
    $url->_expect('mac_path', 'foo:bar');

    # Some edge cases
#    $url = new Catalyst::SmartURI::URL 'file:';
#    $url->_expect('unix_path', '/');
    $url = new Catalyst::SmartURI::URL 'file:/';
    $url->_expect('unix_path', '/');
    $url = new Catalyst::SmartURI::URL 'file:.';
    $url->_expect('unix_path', '.');
    $url = new Catalyst::SmartURI::URL 'file:./foo';
    $url->_expect('unix_path', './foo');
    $url = new Catalyst::SmartURI::URL 'file:0';
    $url->_expect('unix_path', '0');
    $url = new Catalyst::SmartURI::URL 'file:../../foo';
    $url->_expect('unix_path', '../../foo');
    $url = new Catalyst::SmartURI::URL 'file:foo/../bar';
    $url->_expect('unix_path', 'foo/../bar');

    # Relative files
    $url = new Catalyst::SmartURI::URL 'file:foo/b%61r/Note.txt';
    $url->_expect('unix_path', 'foo/bar/Note.txt');
    $url->_expect('mac_path', ':foo:bar:Note.txt');
    $url->_expect('dos_path', 'FOO\\BAR\\NOTE.TXT');
    #$url->_expect('vms_path', '[.FOO.BAR]NOTE.TXT');

    # The VMS path found in RFC 1738 (section 3.10)
    $url = new Catalyst::SmartURI::URL 'file://vms.host.edu/disk$user/my/notes/note12345.txt';
#    $url->_expect('vms_path', 'DISK$USER:[MY.NOTES]NOTE12345.TXT');
#    $url->_expect('mac_path', 'disk$user:my:notes:note12345.txt');

    chdir($savedir) or die $!;
}


#####################################################################
#
# absolute_test()
#
sub absolute_test {

    print "Test relative/absolute URI::URL parsing:\n";

    # Tests from draft-ietf-uri-relative-url-06.txt
    # Copied verbatim from the draft, parsed below

    @URI::URL::g::ISA = qw(URI::URL::_generic); # for these tests

    my $base = 'http://a/b/c/d;p?q#f';

    $absolute_tests = <<EOM;
5.1.  Normal Examples

      g:h        = <URL:g:h>
      g          = <URL:http://a/b/c/g>
      ./g        = <URL:http://a/b/c/g>
      g/         = <URL:http://a/b/c/g/>
      /g         = <URL:http://a/g>
      //g        = <URL:http://g>
#      ?y         = <URL:http://a/b/c/d;p?y>
      g?y        = <URL:http://a/b/c/g?y>
      g?y/./x    = <URL:http://a/b/c/g?y/./x>
      #s         = <URL:http://a/b/c/d;p?q#s>
      g#s        = <URL:http://a/b/c/g#s>
      g#s/./x    = <URL:http://a/b/c/g#s/./x>
      g?y#s      = <URL:http://a/b/c/g?y#s>
 #     ;x         = <URL:http://a/b/c/d;x>
      g;x        = <URL:http://a/b/c/g;x>
      g;x?y#s    = <URL:http://a/b/c/g;x?y#s>
      .          = <URL:http://a/b/c/>
      ./         = <URL:http://a/b/c/>
      ..         = <URL:http://a/b/>
      ../        = <URL:http://a/b/>
      ../g       = <URL:http://a/b/g>
      ../..      = <URL:http://a/>
      ../../     = <URL:http://a/>
      ../../g    = <URL:http://a/g>

5.2.  Abnormal Examples

   Although the following abnormal examples are unlikely to occur
   in normal practice, all URL parsers should be capable of resolving
   them consistently.  Each example uses the same base as above.

   An empty reference resolves to the complete base URL:

      <>         = <URL:http://a/b/c/d;p?q#f>

   Parsers must be careful in handling the case where there are more
   relative path ".." segments than there are hierarchical levels in
   the base URL's path.  Note that the ".." syntax cannot be used to
   change the <net_loc> of a URL.

     ../../../g = <URL:http://a/../g>
     ../../../../g = <URL:http://a/../../g>

   Similarly, parsers must avoid treating "." and ".." as special
   when they are not complete components of a relative path.

      /./g       = <URL:http://a/./g>
      /../g      = <URL:http://a/../g>
      g.         = <URL:http://a/b/c/g.>
      .g         = <URL:http://a/b/c/.g>
      g..        = <URL:http://a/b/c/g..>
      ..g        = <URL:http://a/b/c/..g>

   Less likely are cases where the relative URL uses unnecessary or
   nonsensical forms of the "." and ".." complete path segments.

      ./../g     = <URL:http://a/b/g>
      ./g/.      = <URL:http://a/b/c/g/>
      g/./h      = <URL:http://a/b/c/g/h>
      g/../h     = <URL:http://a/b/c/h>

   Finally, some older parsers allow the scheme name to be present in
   a relative URL if it is the same as the base URL scheme.  This is
   considered to be a loophole in prior specifications of partial
   URLs [1] and should be avoided by future parsers.

      http:g     = <URL:http:g>
      http:      = <URL:http:>
EOM
    # convert text to list like
    # @absolute_tests = ( ['g:h' => 'g:h'], ...)

    for $line (split("\n", $absolute_tests)) {
	next unless $line =~ /^\s{6}/;
	if ($line =~ /^\s+(\S+)\s*=\s*<URL:([^>]*)>/) {
	    my($rel, $abs) = ($1, $2);
	    $rel = '' if $rel eq '<>';
	    push(@absolute_tests, [$rel, $abs]);
	}
	else {
	    warn "illegal line '$line'";
	}
    }

    # add some extra ones for good measure

    push(@absolute_tests, ['x/y//../z' => 'http://a/b/c/x/y/z'],
			  ['1'         => 'http://a/b/c/1'    ],
			  ['0'         => 'http://a/b/c/0'    ],
			  ['/0'        => 'http://a/0'        ],
#			  ['%2e/a'     => 'http://a/b/c/%2e/a'],  # %2e is '.'
#			  ['%2e%2e/a'  => 'http://a/b/c/%2e%2e/a'],
	);

    print "  Relative    +  Base  =>  Expected Absolute URL\n";
    print "================================================\n";
    for $test (@absolute_tests) {
	my($rel, $abs) = @$test;
	my $abs_url = new Catalyst::SmartURI::URL $abs;
	my $abs_str = $abs_url->as_string;

	printf("  %-10s  +  $base  =>  %s\n", $rel, $abs);
	my $u   = new Catalyst::SmartURI::URL $rel, $base;
	my $got = $u->abs;
	$got->_expect('as_string', $abs_str);
    }

    # bug found and fixed in 1.9 by "J.E. Fritz" <FRITZ@gems.vcu.edu>
    $base = new Catalyst::SmartURI::URL 'http://host/directory/file';
    my $relative = new Catalyst::SmartURI::URL 'file', $base;
    my $result = $relative->abs;

    my ($a, $b) = ($base->path, $result->path);
	die "'$a' and '$b' should be the same" unless $a eq $b;

    # Counter the expectation of least surprise,
    # section 6 of the draft says the URL should
    # be canonicalised, rather than making a simple
    # substitution of the last component.
    # Better doublecheck someone hasn't "fixed this bug" :-)
    $base = new Catalyst::SmartURI::URL 'http://host/dir1/../dir2/file';
    $relative = new Catalyst::SmartURI::URL 'file', $base;
    $result = $relative->abs;
    die 'URL not canonicalised' unless $result eq 'http://host/dir2/file';

    print "--------\n";
    # Test various other kinds of URLs and how they like to be absolutized
    for (["http://abc/", "news:45664545", "http://abc/"],
	 ["news:abc",    "http://abc/",   "news:abc"],
	 ["abc",         "file:/test?aas", "file:/abc"],
#	 ["gopher:",     "",               "gopher:"],
#	 ["?foo",        "http://abc/a",   "http://abc/a?foo"],
	 ["?foo",        "file:/abc",      "file:/?foo"],
	 ["#foo",        "http://abc/a",   "http://abc/a#foo"],
	 ["#foo",        "file:a",         "file:a#foo"],
	 ["#foo",        "file:/a",         "file:/a#foo"],
	 ["#foo",        "file:/a",         "file:/a#foo"],
	 ["#foo",        "file://localhost/a", "file://localhost/a#foo"],
	 ['123@sn.no',   "news:comp.lang.perl.misc", 'news:/123@sn.no'],
	 ['no.perl',     'news:123@sn.no',           'news:/no.perl'],
	 ['mailto:aas@a.sn.no', "http://www.sn.no/", 'mailto:aas@a.sn.no'],

	 # Test absolutizing with old behaviour.
	 ['http:foo',     'http://h/a/b',   'http://h/a/foo'],
	 ['http:/foo',    'http://h/a/b',   'http://h/foo'],
	 ['http:?foo',    'http://h/a/b',   'http://h/a/b?foo'],
	 ['http:#foo',    'http://h/a/b',   'http://h/a/b#foo'],
	 ['http:?foo#bar','http://h/a/b',   'http://h/a/b?foo#bar'],
	 ['file:/foo',    'http://h/a/b',   'file:/foo'],

	)
    {
	my($url, $base, $expected_abs) = @$_;
	my $rel = new Catalyst::SmartURI::URL $url, $base;
	my $abs = $rel->abs($base, 1);
	printf("  %-12s+  $base  =>  %s\n", $rel, $abs);
	$abs->_expect('as_string', $expected_abs);
    }
    print "absolute test ok\n";

    # Test relative function
    for (
	 ["http://abc/a",   "http://abc",        "a"],
	 ["http://abc/a",   "http://abc/b",      "a"],
	 ["http://abc/a?q", "http://abc/b",      "a?q"],
	 ["http://abc/a;p", "http://abc/b",      "a;p"],
	 ["http://abc/a",   "http://abc/a/b/c/", "../../../a"],
         ["http://abc/a/",  "http://abc/a/",     "./"],
         ["http://abc/a#f", "http://abc/a",      "#f"],

	 ["file:/etc/motd", "file:/",            "etc/motd"],
	 ["file:/etc/motd", "file:/etc/passwd",  "motd"],
	 ["file:/etc/motd", "file:/etc/rc2.d/",  "../motd"],
	 ["file:/etc/motd", "file:/usr/lib/doc", "../../etc/motd"],
         ["file:",          "file:/etc/",        "../"],
         ["file:foo",       "file:/etc/",        "../foo"],

	 ["mailto:aas",     "http://abc",        "mailto:aas"],

	 # Nicolai Langfeldt's original example
	 ["http://www.math.uio.no/doc/mail/top.html",
	  "http://www.math.uio.no/doc/linux/", "../mail/top.html"],
        )
    {
	my($abs, $base, $expect) = @$_;
	printf "url('$abs', '$base')->rel eq '$expect'\n";
	my $rel = Catalyst::SmartURI::URL->new($abs, $base)->rel;
	$rel->_expect('as_string', $expect);
    }
    print "relative test ok\n";
}


sub eq_test
{
    my $u1 = new Catalyst::SmartURI::URL 'http://abc.com:80/~smith/home.html';
    my $u2 = new Catalyst::SmartURI::URL 'http://ABC.com/%7Esmith/home.html';
    my $u3 = new Catalyst::SmartURI::URL 'http://ABC.com:/%7esmith/home.html';

    # Test all permutations of these tree
    $u1->eq($u2) or die "1: $u1 ne $u2";
    $u1->eq($u3) or die "2: $u1 ne $u3";
    $u2->eq($u1) or die "3: $u2 ne $u1";
    $u2->eq($u3) or die "4: $u2 ne $u3";
    $u3->eq($u1) or die "5: $u3 ne $u1";
    $u3->eq($u2) or die "6: $u3 ne $u2";

    # Test empty path
    my $u4 = new Catalyst::SmartURI::URL 'http://www.sn.no';
    $u4->eq("HTTP://WWW.SN.NO:80/") or die "7: $u4";
    $u4->eq("http://www.sn.no:81") and die "8: $u4";

    # Test mailto
#    my $u5 = new Catalyst::SmartURI::URL 'mailto:AAS@SN.no';
#    $u5->eq('mailto:aas@sn.no') or die "9: $u5";

    # Test reserved char
    my $u6 = new Catalyst::SmartURI::URL 'ftp://ftp/%2Fetc';
    $u6->eq("ftp://ftp/%2fetc") or die "10: $u6";
    $u6->eq("ftp://ftp://etc") and die "11: $u6";
}

