git.maemo.org Git - pkg-perl/blob - deb-src/liburi-perl/liburi-perl-1.35.dfsg.1/t/old-file.t

   1 #!perl -w
   2
   3 use URI::file;
   4 $URI::file::DEFAULT_AUTHORITY = undef;
   5
   6 @tests =  (
   7 [ "file",          "unix",       "win32",         "mac" ],
   8 #----------------  ------------  ---------------  --------------
   9 [ "file://localhost/foo/bar",
  10                    "!/foo/bar",  "!\\foo\\bar",   "!foo:bar", ],
  11 [ "file:///foo/bar",
  12                    "!/foo/bar",  "!\\foo\\bar",   "!foo:bar", ],
  13 [ "file:/foo/bar", "/foo/bar",   "\\foo\\bar",    "foo:bar", ],
  14 [ "foo/bar",       "foo/bar",    "foo\\bar",      ":foo:bar",],
  15 [ "file://foo/bar","!//foo/bar", "\\\\foo\\bar",  "!foo:bar"],
  16 [ "file://a:/",    "!//a:/",     "!A:\\",          undef],
  17 [ "file:/",        "/",          "\\",             undef],
  18 [ "file://A:relative/", "!//A:relative/", "A:",    undef],
  19 [ ".",             ".",          ".",              ":"],
  20 [ "..",            "..",         "..",             "::"],
  21 [ "%2E",           "!.",          "!.",            ":."],
  22 [ "../%2E%2E",     "!../..",      "!..\\..",       "::.."],
  23 );
  24 if ($^O eq "MacOS") {
  25 @extratests = (
  26 [ "../..",        "../..",         "..\\..",           ":::"],
  27 [ "../../",       "../../",        "..\\..\\",         "!:::"],
  28 [ "file:./foo.bar", "!./foo.bar",    "!.\\foo.bar",       "!:foo.bar"],
  29 [ "file:/%2Ffoo/bar", undef,      undef,           "/foo:bar"],
  30 [ "file:/.%2Ffoo/bar", undef,      undef,           "./foo:bar"],
  31 [ "file:/fee/.%2Ffoo%2Fbar", undef,      undef,           "fee:./foo/bar"],
  32 [ "file:/.%2Ffoo%2Fbar/", undef,      undef,           "./foo/bar:"],
  33 [ "file:/.%2Ffoo%2Fbar", undef,      undef,           "!./foo/bar:"],
  34 [ "file:/%2E%2E/foo",   "!/../foo",   "!\\..\\foo" , "..:foo"],
  35 [ "file:/bar/%2E/foo", "!/bar/./foo",  "!\\bar\\.\\foo", "bar:.:foo"],
  36 [ "file:/foo/../bar",  "/foo/../bar",  "\\foo\\..\\bar", "foo::bar"],
  37 [ "file:/a/b/../../c/d",  "/a/b/../../c/d",  "\\a\\b\\..\\..\\c\\d", "a:b:::c:d"],
  38 );
  39   push(@tests,@extratests);
  40 }
  41
  42 @os = @{shift @tests};
  43 shift @os;  # file
  44
  45 my $num = @tests;
  46 print "1..$num\n";
  47
  48 $testno = 1;
  49
  50 for $t (@tests) {
  51    my @t = @$t;
  52    my $file = shift @t;
  53    my $err;
  54
  55    my $u = URI->new($file, "file");
  56    my $i = 0;
  57    for $os (@os) {
  58        my $f = $u->file($os);
  59        my $expect = $t[$i];
  60        $f = "<undef>" unless defined $f;
  61        $expect = "<undef>" unless defined $expect;
  62        my $loose;
  63        $loose++ if $expect =~ s/^!//;
  64        if ($expect ne $f) {
  65            print "URI->new('$file', 'file')->file('$os') ne $expect, but $f\n";
  66            $err++;
  67        }
  68        if (defined($t[$i]) && !$loose) {
  69            $u2 = URI::file->new($t[$i], $os);
  70            unless ($u2->as_string eq $file) {
  71               print "URI::file->new('$t[$i]', '$os') ne $file, but $u2\n";
  72               $err++;
  73            }
  74        }
  75        $i++;
  76    }
  77    print "not " if $err;
  78    print "ok $testno\n";
  79    $testno++;
  80 }