vcs.maemo.org Git - dh-make-perl/blob - dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/t/roy-test.t

   1 #!perl -w
   2
   3 print "1..102\n";
   4
   5 if (-d "t") {
   6    chdir("t") || die "Can't chdir 't': $!";
   7    # fix all relative library locations
   8    foreach (@INC) {
   9       $_ = "../$_" unless m,^/,;
  10    }
  11 }
  12
  13 use URI;
  14 $no = 1;
  15
  16 for $i (1..5) {
  17    my $file = "roytest$i.html";
  18
  19    open(FILE, $file) || die "Can't open $file: $!";
  20    print "# $file\n";
  21    $base = undef;
  22    while (<FILE>) {
  23        if (/^<BASE href="([^"]+)">/) {
  24            $base = URI->new($1);
  25        } elsif (/^<a href="([^"]*)">.*<\/a>\s*=\s*(\S+)/) {
  26            die "Missing base at line $." unless $base;
  27            $link = $1;
  28            $exp  = $2;
  29            $exp = $base if $exp =~ /current/;  # special case test 22
  30
  31            # rfc2396bis restores the rfc1808 behaviour
  32            if ($no == 7) {
  33                $exp = "http://a/b/c/d;p?y";
  34            }
  35            elsif ($no == 48) {
  36                $exp = "http://a/b/c/d;p?y";
  37            }
  38
  39            $abs  = URI->new($link)->abs($base);
  40            unless ($abs eq $exp) {
  41               print "$file:$.:  Expected: $exp\n";
  42               print qq(  abs("$link","$base") ==> "$abs"\n);
  43               print "not ";
  44            }
  45            print "ok $no\n";
  46            $no++;
  47        }
  48    }
  49    close(FILE);
  50 }