diff options
author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-07-25 01:06:42 +0000 |
---|---|---|
committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-07-25 01:06:42 +0000 |
commit | 9165b237ad8fae18b36d4d40d6e2ccfde7b136c7 (patch) | |
tree | 06530ddd6baa7e251c58b6b6729ed458da61a681 /t/roy-test.t | |
download | URI-tarball-master.tar.gz |
Diffstat (limited to 't/roy-test.t')
-rw-r--r-- | t/roy-test.t | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/t/roy-test.t b/t/roy-test.t new file mode 100644 index 0000000..a7a9fdc --- /dev/null +++ b/t/roy-test.t @@ -0,0 +1,44 @@ +use strict; +use warnings; + +use Test qw(plan ok); +plan tests => 102; + +use URI; +use File::Spec::Functions qw(catfile); + +my $no = 1; + +my @prefix; +push(@prefix, "t") if -d "t"; + +for my $i (1..5) { + my $file = catfile(@prefix, "roytest$i.html"); + + open(FILE, $file) || die "Can't open $file: $!"; + print "# $file\n"; + my $base = undef; + while (<FILE>) { + if (/^<BASE href="([^"]+)">/) { + $base = URI->new($1); + } elsif (/^<a href="([^"]*)">.*<\/a>\s*=\s*(\S+)/) { + die "Missing base at line $." unless $base; + my $link = $1; + my $exp = $2; + $exp = $base if $exp =~ /current/; # special case test 22 + + # rfc2396bis restores the rfc1808 behaviour + if ($no == 7) { + $exp = "http://a/b/c/d;p?y"; + } + elsif ($no == 48) { + $exp = "http://a/b/c/d;p?y"; + } + + ok(URI->new($link)->abs($base), $exp); + + $no++; + } + } + close(FILE); +} |