File::Spec in XS
authorZefram <zefram@fysh.org>
Thu, 28 Feb 2013 16:48:01 +0000 (16:48 +0000)
committerZefram <zefram@fysh.org>
Sat, 17 Aug 2013 15:37:18 +0000 (16:37 +0100)
Reimplement parts of File::Spec in XS.  Mainly File::Spec::Unix methods.

The methods can be used as methods on File::Spec::Unix, as methods
inherited by File::Spec::$notunix, and as standalone functions.  Quite a
lot of complexity comes from making them work in all of these roles,
without the compatibility damaging the performance of any of them.
The methods therefore need to check their invocant, using C code
where the invocant is File::Spec::Unix, and calling other methods if
it is not, so that they play nicely in composition with other methods.
The standalone function is another XS entry point, entirely unencumbered
by OO interface paraphernalia.  File::Spec::Functions is modified to
pick up the separate function version.

There is new logic for File::Spec to fall back to pure Perl, in the way
that Cwd.pm already does, for XS-impaired systems.

14 files changed:
dist/Cwd/Cwd.pm
dist/Cwd/Cwd.xs
dist/Cwd/Makefile.PL
dist/Cwd/lib/File/Spec.pm
dist/Cwd/lib/File/Spec/Cygwin.pm
dist/Cwd/lib/File/Spec/Epoc.pm
dist/Cwd/lib/File/Spec/Functions.pm
dist/Cwd/lib/File/Spec/Mac.pm
dist/Cwd/lib/File/Spec/OS2.pm
dist/Cwd/lib/File/Spec/Unix.pm
dist/Cwd/lib/File/Spec/VMS.pm
dist/Cwd/lib/File/Spec/Win32.pm
dist/Cwd/t/Functions.t
dist/Cwd/t/Spec.t

index 5cbb9d8..bd19ea7 100644 (file)
@@ -171,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.41';
+$VERSION = '3.44';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//;
 
@@ -242,16 +242,18 @@ sub _vms_efs {
 
 
 # If loading the XS stuff doesn't work, we can fall back to pure perl
-eval {
-  if ( $] >= 5.006 ) {
-    require XSLoader;
-    XSLoader::load( __PACKAGE__, $xs_version);
-  } else {
-    require DynaLoader;
-    push @ISA, 'DynaLoader';
-    __PACKAGE__->bootstrap( $xs_version );
-  }
-};
+unless (defined &getcwd) {
+  eval {
+    if ( $] >= 5.006 ) {
+      require XSLoader;
+      XSLoader::load( __PACKAGE__, $xs_version);
+    } else {
+      require DynaLoader;
+      push @ISA, 'DynaLoader';
+      __PACKAGE__->bootstrap( $xs_version );
+    }
+  };
+}
 
 # Big nasty table of function aliases
 my %METHOD_MAP =
index 3940006..a18afd1 100644 (file)
@@ -396,11 +396,149 @@ int Perl_getcwd_sv(pTHX_ SV *sv)
 
 #endif
 
+#if defined(START_MY_CXT) && defined(MY_CXT_CLONE)
+# define USE_MY_CXT 1
+#else
+# define USE_MY_CXT 0
+#endif
+
+#if USE_MY_CXT
+# define MY_CXT_KEY "Cwd::_guts"XS_VERSION
+typedef struct {
+    SV *empty_string_sv, *slash_string_sv;
+} my_cxt_t;
+START_MY_CXT
+# define dUSE_MY_CXT dMY_CXT
+# define EMPTY_STRING_SV MY_CXT.empty_string_sv
+# define SLASH_STRING_SV MY_CXT.slash_string_sv
+# define POPULATE_MY_CXT do { \
+       MY_CXT.empty_string_sv = newSVpvs(""); \
+       MY_CXT.slash_string_sv = newSVpvs("/"); \
+    } while(0)
+#else
+# define dUSE_MY_CXT dNOOP
+# define EMPTY_STRING_SV sv_2mortal(newSVpvs(""))
+# define SLASH_STRING_SV sv_2mortal(newSVpvs("/"))
+#endif
+
+#define invocant_is_unix(i) THX_invocant_is_unix(aTHX_ i)
+static
+bool
+THX_invocant_is_unix(pTHX_ SV *invocant)
+{
+    /*
+     * This is used to enable optimisations that avoid method calls
+     * by knowing how they would resolve.  False negatives, disabling
+     * the optimisation where it would actually behave correctly, are
+     * acceptable.
+     */
+    return SvPOK(invocant) && SvCUR(invocant) == 16 &&
+       !memcmp(SvPVX(invocant), "File::Spec::Unix", 16);
+}
+
+#define unix_canonpath(p) THX_unix_canonpath(aTHX_ p)
+static
+SV *
+THX_unix_canonpath(pTHX_ SV *path)
+{
+    SV *retval;
+    char const *p, *pe, *q;
+    STRLEN l;
+    char *o;
+    STRLEN plen;
+    SvGETMAGIC(path);
+    if(!SvOK(path)) return &PL_sv_undef;
+    p = SvPV_nomg(path, plen);
+    if(plen == 0) return newSVpvs("");
+    pe = p + plen;
+    retval = newSV(plen);
+#ifdef SvUTF8
+    if(SvUTF8(path)) SvUTF8_on(retval);
+#endif
+    o = SvPVX(retval);
+    if(DOUBLE_SLASHES_SPECIAL && p[0] == '/' && p[1] == '/' && p[2] != '/') {
+       q = memchr(p+2, '/', pe-(p+2));
+       if(!q) q = pe;
+       l = q - p;
+       memcpy(o, p, l);
+       p = q;
+       o += l;
+    }
+    /*
+     * The transformations performed here are:
+     *   . squeeze multiple slashes
+     *   . eliminate "." segments, except one if that's all there is
+     *   . eliminate leading ".." segments
+     *   . eliminate trailing slash, unless it's all there is
+     */
+    if(p[0] == '/') {
+       *o++ = '/';
+       while(1) {
+           do { p++; } while(p[0] == '/');
+           if(p[0] == '.' && p[1] == '.' && (p+2 == pe || p[2] == '/')) {
+               p++;
+               /* advance past second "." next time round loop */
+           } else if(p[0] == '.' && (p+1 == pe || p[1] == '/')) {
+               /* advance past "." next time round loop */
+           } else {
+               break;
+           }
+       }
+    } else if(p[0] == '.' && p[1] == '/') {
+       do {
+           p++;
+           do { p++; } while(p[0] == '/');
+       } while(p[0] == '.' && p[1] == '/');
+       if(p == pe) *o++ = '.';
+    }
+    if(p == pe) goto end;
+    while(1) {
+       q = memchr(p, '/', pe-p);
+       if(!q) q = pe;
+       l = q - p;
+       memcpy(o, p, l);
+       p = q;
+       o += l;
+       if(p == pe) goto end;
+       while(1) {
+           do { p++; } while(p[0] == '/');
+           if(p == pe) goto end;
+           if(p[0] != '.') break;
+           if(p+1 == pe) goto end;
+           if(p[1] != '/') break;
+           p++;
+       }
+       *o++ = '/';
+    }
+    end: ;
+    *o = 0;
+    SvPOK_on(retval);
+    SvCUR_set(retval, o - SvPVX(retval));
+    return retval;
+}
 
 MODULE = Cwd           PACKAGE = Cwd
 
 PROTOTYPES: DISABLE
 
+BOOT:
+#if USE_MY_CXT
+{
+    MY_CXT_INIT;
+    POPULATE_MY_CXT;
+}
+#endif
+
+#if USE_MY_CXT
+
+void
+CLONE(...)
+CODE:
+       PERL_UNUSED_VAR(items);
+       { MY_CXT_CLONE; POPULATE_MY_CXT; }
+
+#endif
+
 void
 getcwd(...)
 ALIAS:
@@ -485,3 +623,146 @@ PPCODE:
 }
 
 #endif
+
+MODULE = Cwd           PACKAGE = File::Spec::Unix
+
+SV *
+canonpath(SV *self, SV *path = &PL_sv_undef, ...)
+CODE:
+    PERL_UNUSED_VAR(self);
+    RETVAL = unix_canonpath(path);
+OUTPUT:
+    RETVAL
+
+SV *
+_fn_canonpath(SV *path = &PL_sv_undef, ...)
+CODE:
+    RETVAL = unix_canonpath(path);
+OUTPUT:
+    RETVAL
+
+SV *
+catdir(SV *self, ...)
+PREINIT:
+    dUSE_MY_CXT;
+    SV *joined;
+CODE:
+    EXTEND(SP, items+1);
+    ST(items) = EMPTY_STRING_SV;
+    joined = sv_newmortal();
+    do_join(joined, SLASH_STRING_SV, &ST(0), &ST(items));
+    if(invocant_is_unix(self)) {
+       RETVAL = unix_canonpath(joined);
+    } else {
+       ENTER;
+       PUSHMARK(SP);
+       EXTEND(SP, 2);
+       PUSHs(self);
+       PUSHs(joined);
+       PUTBACK;
+       call_method("canonpath", G_SCALAR);
+       SPAGAIN;
+       RETVAL = POPs;
+       LEAVE;
+       SvREFCNT_inc(RETVAL);
+    }
+OUTPUT:
+    RETVAL
+
+SV *
+_fn_catdir(...)
+PREINIT:
+    dUSE_MY_CXT;
+    SV *joined;
+CODE:
+    EXTEND(SP, items+1);
+    ST(items) = EMPTY_STRING_SV;
+    joined = sv_newmortal();
+    do_join(joined, SLASH_STRING_SV, &ST(-1), &ST(items));
+    RETVAL = unix_canonpath(joined);
+OUTPUT:
+    RETVAL
+
+SV *
+catfile(SV *self, ...)
+PREINIT:
+    dUSE_MY_CXT;
+CODE:
+    if(invocant_is_unix(self)) {
+       if(items == 1) {
+           RETVAL = &PL_sv_undef;
+       } else {
+           SV *file = unix_canonpath(ST(items-1));
+           if(items == 2) {
+               RETVAL = file;
+           } else {
+               SV *dir = sv_newmortal();
+               sv_2mortal(file);
+               ST(items-1) = EMPTY_STRING_SV;
+               do_join(dir, SLASH_STRING_SV, &ST(0), &ST(items-1));
+               RETVAL = unix_canonpath(dir);
+               if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/')
+                   sv_catsv(RETVAL, SLASH_STRING_SV);
+               sv_catsv(RETVAL, file);
+           }
+       }
+    } else {
+       SV *file, *dir;
+       ENTER;
+       PUSHMARK(SP);
+       EXTEND(SP, 2);
+       PUSHs(self);
+       PUSHs(items == 1 ? &PL_sv_undef : ST(items-1));
+       PUTBACK;
+       call_method("canonpath", G_SCALAR);
+       SPAGAIN;
+       file = POPs;
+       LEAVE;
+       if(items <= 2) {
+           RETVAL = SvREFCNT_inc(file);
+       } else {
+           char const *pv;
+           STRLEN len;
+           bool need_slash;
+           SP--;
+           ENTER;
+           PUSHMARK(&ST(-1));
+           PUTBACK;
+           call_method("catdir", G_SCALAR);
+           SPAGAIN;
+           dir = POPs;
+           LEAVE;
+           pv = SvPV(dir, len);
+           need_slash = len == 0 || pv[len-1] != '/';
+           RETVAL = newSVsv(dir);
+           if(need_slash) sv_catsv(RETVAL, SLASH_STRING_SV);
+           sv_catsv(RETVAL, file);
+       }
+    }
+OUTPUT:
+    RETVAL
+
+SV *
+_fn_catfile(...)
+PREINIT:
+    dUSE_MY_CXT;
+CODE:
+    if(items == 0) {
+       RETVAL = &PL_sv_undef;
+    } else {
+       SV *file = unix_canonpath(ST(items-1));
+       if(items == 1) {
+           RETVAL = file;
+       } else {
+           SV *dir = sv_newmortal();
+           sv_2mortal(file);
+           ST(items-1) = EMPTY_STRING_SV;
+           do_join(dir, SLASH_STRING_SV, &ST(-1), &ST(items-1));
+           RETVAL = unix_canonpath(dir);
+           if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/')
+               sv_catsv(RETVAL, SLASH_STRING_SV);
+           sv_catsv(RETVAL, file);
+       }
+    }
+OUTPUT:
+    RETVAL
index db5fbc7..1add839 100644 (file)
@@ -1,7 +1,6 @@
 
 BEGIN { @INC = grep {!/blib/} @INC }
 
-# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
 require 5.005;
 use ExtUtils::MakeMaker;
 WriteMakefile
@@ -9,11 +8,10 @@ WriteMakefile
           'DISTNAME' => 'PathTools',
          'NAME' => 'Cwd',
           'VERSION_FROM' => 'Cwd.pm',
-         (
-          (grep { $_ eq 'PERL_CORE=1' } @ARGV)
-          ? ('DEFINE' => '-DNO_PPPORT_H')
-          : ()
-         ),
+          'DEFINE' => join(" ",
+                "-DDOUBLE_SLASHES_SPECIAL=@{[$^O eq q(qnx) || $^O eq q(nto) ? 1 : 0]}",
+                ((grep { $_ eq 'PERL_CORE=1' } @ARGV) ? '-DNO_PPPORT_H' : ()),
+          ),
           'PREREQ_PM' => {
                            'Carp' => '0',
                            'File::Basename' => '0',
index 5f7157a..7d5ef55 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.41';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 my %module = (MacOS   => 'Mac',
index 4c89071..a6e2bbd 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.41';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
index 7c0354f..f618175 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.41';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 require File::Spec::Unix;
index f5b9046..5d4d81c 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 
 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 
-$VERSION = '3.40';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 require Exporter;
@@ -37,10 +37,30 @@ require Exporter;
 
 %EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
 
+require File::Spec::Unix;
+my %udeps = (
+    canonpath => [],
+    catdir => [qw(canonpath)],
+    catfile => [qw(canonpath catdir)],
+    case_tolerant => [],
+    curdir => [],
+    devnull => [],
+    rootdir => [],
+    updir => [],
+);
+
 foreach my $meth (@EXPORT, @EXPORT_OK) {
     my $sub = File::Spec->can($meth);
     no strict 'refs';
-    *{$meth} = sub {&$sub('File::Spec', @_)};
+    if (exists($udeps{$meth}) && $sub == File::Spec::Unix->can($meth) &&
+           !(grep {
+               File::Spec->can($_) != File::Spec::Unix->can($_)
+           } @{$udeps{$meth}}) &&
+           defined(&{"File::Spec::Unix::_fn_$meth"})) {
+       *{$meth} = \&{"File::Spec::Unix::_fn_$meth"};
+    } else {
+       *{$meth} = sub {&$sub('File::Spec', @_)};
+    }
 }
 
 
index 1a8cd0f..f44aa22 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.41';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
index 70f4d13..bc745ee 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.41';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
index 98b7f1b..b2b5357 100644 (file)
@@ -3,9 +3,21 @@ package File::Spec::Unix;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '3.41';
+$VERSION = '3.44';
+my $xs_version = $VERSION;
 $VERSION =~ tr/_//;
 
+unless (defined &canonpath) {
+  eval {
+    if ( $] >= 5.006 ) {
+       require XSLoader;
+       XSLoader::load("Cwd", $xs_version);
+    } else {
+       require Cwd;
+    }
+  };
+}
+
 =head1 NAME
 
 File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
@@ -40,7 +52,7 @@ actually traverse the filesystem cleaning up paths like this.
 
 =cut
 
-sub canonpath {
+sub _pp_canonpath {
     my ($self,$path) = @_;
     return unless defined $path;
     
@@ -69,6 +81,7 @@ sub canonpath {
     $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
     return "$node$path";
 }
+*canonpath = \&_pp_canonpath unless defined &canonpath;
 
 =item catdir()
 
@@ -80,11 +93,12 @@ trailing slash :-)
 
 =cut
 
-sub catdir {
+sub _pp_catdir {
     my $self = shift;
 
     $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
 }
+*catdir = \&_pp_catdir unless defined &catdir;
 
 =item catfile
 
@@ -93,7 +107,7 @@ complete path ending with a filename
 
 =cut
 
-sub catfile {
+sub _pp_catfile {
     my $self = shift;
     my $file = $self->canonpath(pop @_);
     return $file unless @_;
@@ -101,6 +115,7 @@ sub catfile {
     $dir .= "/" unless substr($dir,-1) eq "/";
     return $dir.$file;
 }
+*catfile = \&_pp_catfile unless defined &catfile;
 
 =item curdir
 
@@ -109,6 +124,7 @@ Returns a string representation of the current directory.  "." on UNIX.
 =cut
 
 sub curdir { '.' }
+use constant _fn_curdir => ".";
 
 =item devnull
 
@@ -117,6 +133,7 @@ Returns a string representation of the null device. "/dev/null" on UNIX.
 =cut
 
 sub devnull { '/dev/null' }
+use constant _fn_devnull => "/dev/null";
 
 =item rootdir
 
@@ -125,6 +142,7 @@ Returns a string representation of the root directory.  "/" on UNIX.
 =cut
 
 sub rootdir { '/' }
+use constant _fn_rootdir => "/";
 
 =item tmpdir
 
@@ -191,6 +209,7 @@ Returns a string representation of the parent directory.  ".." on UNIX.
 =cut
 
 sub updir { '..' }
+use constant _fn_updir => "..";
 
 =item no_upwards
 
@@ -212,6 +231,7 @@ is not or is significant when comparing file specifications.
 =cut
 
 sub case_tolerant { 0 }
+use constant _fn_case_tolerant => 0;
 
 =item file_name_is_absolute
 
index 8fb79db..8ce9644 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.43';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
index 5cc8693..f8d3d27 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.42';
+$VERSION = '3.44';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
index 6ab225f..122c529 100644 (file)
@@ -1,9 +1,19 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 3;
+use Test::More tests => 15;
 BEGIN {use_ok('File::Spec::Functions', ':ALL');}
 
+is(canonpath('a/b/c'), File::Spec->canonpath('a/b/c'));
+is(case_tolerant(), File::Spec->case_tolerant());
+is(catdir(), File::Spec->catdir());
+is(catdir('a'), File::Spec->catdir('a'));
+is(catdir('a','b'), File::Spec->catdir('a','b'));
+is(catdir('a','b','c'), File::Spec->catdir('a','b','c'));
+is(catfile(), File::Spec->catfile());
+is(catfile('a'), File::Spec->catfile('a'));
+is(catfile('a','b'), File::Spec->catfile('a','b'));
 is(catfile('a','b','c'), File::Spec->catfile('a','b','c'));
-
-# seems to return 0 or 1, so see if we can call it - 2003-07-07 tels
-like(case_tolerant(), qr/\A(?:0|1)\z/);
+is(curdir(), File::Spec->curdir());
+is(devnull(), File::Spec->devnull());
+is(rootdir(), File::Spec->rootdir());
+is(updir(), File::Spec->updir());
index 99f83c4..74c18aa 100644 (file)
@@ -56,6 +56,11 @@ my @tests = (
 [ "Unix->catfile('./a','b','c')",       'a/b/c'  ],
 [ "Unix->catfile('c')",                 'c' ],
 [ "Unix->catfile('./c')",               'c' ],
+[ "Unix->catfile('a', 'b'.chr(0xaf))",         'a/b'.chr(0xaf)   ],
+($] >= 5.008 ? (
+[ "Unix->catfile('a', do { my \$x = 'b'.chr(0xaf); use utf8 (); utf8::upgrade(\$x); \$x })",   'a/b'.chr(0xaf)   ],
+) : ()),
+[ "Unix->catfile(substr('foo', 2))", 'o' ],
 
 [ "Unix->splitpath('file')",            ',,file'            ],
 [ "Unix->splitpath('/d1/d2/d3/')",      ',/d1/d2/d3/,'      ],
@@ -94,17 +99,46 @@ my @tests = (
 [ "Unix->catdir('d1','d2','d3')",       'd1/d2/d3'  ],
 # QNX is POSIXly special
 [ "Unix->catdir('/','d2/d3')",          ( $^O =~ m!^(nto|qnx)! ? '//d2/d3' : '/d2/d3' ) ],
+[ "Unix->catdir('a', 'b'.chr(0xaf))",         'a/b'.chr(0xaf)   ],
+($] >= 5.008 ? (
+[ "Unix->catdir('a', do { my \$x = 'b'.chr(0xaf); use utf8 (); utf8::upgrade(\$x); \$x })",   'a/b'.chr(0xaf)   ],
+) : ()),
 
 [ "Unix->canonpath('///../../..//./././a//b/.././c/././')",   '/a/b/../c' ],
 [ "Unix->canonpath('')",                       ''               ],
 # rt.perl.org 27052
 [ "Unix->canonpath('a/../../b/c')",            'a/../../b/c'    ],
+[ "Unix->canonpath('/')",                      '/'              ],
+[ "Unix->canonpath('///')",                    '/'              ],
 [ "Unix->canonpath('/.')",                     '/'              ],
 [ "Unix->canonpath('/./')",                    '/'              ],
+[ "Unix->canonpath('///.')",                   '/'              ],
+[ "Unix->canonpath('///.///')",                '/'              ],
+[ "Unix->canonpath('///..')",                  '/'              ],
+[ "Unix->canonpath('///..///')",               '/'              ],
+[ "Unix->canonpath('///..///.///..///')",      '/'              ],
+[ "Unix->canonpath('.')",                      '.'              ],
+[ "Unix->canonpath('.///')",                   '.'              ],
+[ "Unix->canonpath('.///.')",                  '.'              ],
+[ "Unix->canonpath('.///.///')",               '.'              ],
+[ "Unix->canonpath('..')",                     '..'             ],
+[ "Unix->canonpath('..///')",                  '..'             ],
+[ "Unix->canonpath('../..')",                  '../..'          ],
+[ "Unix->canonpath('../../')",                 '../..'          ],
+[ "Unix->canonpath('..///.///..///')",         '../..'          ],
+[ "Unix->canonpath('///../../..//./././a//b/.././c/././')",   '/a/b/../c' ],
+[ "Unix->canonpath('a/../../b/c')",            'a/../../b/c'    ],
+[ "Unix->canonpath('a///..///..///b////c')",   'a/../../b/c'    ],
+[ "Unix->canonpath('.///a///.///..///.///..///.///b///.////c///.')",   'a/../../b/c'    ],
 [ "Unix->canonpath('/a/./')",                  '/a'             ],
 [ "Unix->canonpath('/a/.')",                   '/a'             ],
 [ "Unix->canonpath('/../../')",                '/'              ],
 [ "Unix->canonpath('/../..')",                 '/'              ],
+[ "Unix->canonpath('/foo', '/bar')",           '/foo'           ],
+[ "Unix->canonpath('///a'.chr(0xaf))",         '/a'.chr(0xaf)   ],
+($] >= 5.008 ? (
+[ "Unix->canonpath(do { my \$x = '///a'.chr(0xaf); use utf8 (); utf8::upgrade(\$x); \$x })",   '/a'.chr(0xaf)   ],
+) : ()),
 
 [  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          '.'                  ],
 [  "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')",          '../t4'              ],
@@ -802,4 +836,6 @@ for ( @tests ) {
     }
 }
 
+is +File::Spec::Unix->canonpath(), undef;
+
 done_testing();