summaryrefslogtreecommitdiff
path: root/cpan/dist/PathTools/t
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/dist/PathTools/t')
-rw-r--r--cpan/dist/PathTools/t/Functions.t19
-rw-r--r--cpan/dist/PathTools/t/Spec-taint.t17
-rw-r--r--cpan/dist/PathTools/t/Spec.t841
-rw-r--r--cpan/dist/PathTools/t/abs2rel.t76
-rw-r--r--cpan/dist/PathTools/t/crossplatform.t173
-rw-r--r--cpan/dist/PathTools/t/cwd.t284
-rw-r--r--cpan/dist/PathTools/t/lib/Test/Builder.pm1499
-rw-r--r--cpan/dist/PathTools/t/lib/Test/More.pm1330
-rw-r--r--cpan/dist/PathTools/t/lib/Test/Simple.pm235
-rw-r--r--cpan/dist/PathTools/t/lib/Test/Tutorial.pod603
-rw-r--r--cpan/dist/PathTools/t/rel2abs2rel.t73
-rw-r--r--cpan/dist/PathTools/t/rel2abs_vs_symlink.t37
-rw-r--r--cpan/dist/PathTools/t/taint.t53
-rw-r--r--cpan/dist/PathTools/t/tmpdir.t53
-rw-r--r--cpan/dist/PathTools/t/win32.t32
15 files changed, 5325 insertions, 0 deletions
diff --git a/cpan/dist/PathTools/t/Functions.t b/cpan/dist/PathTools/t/Functions.t
new file mode 100644
index 00000000..122c529a
--- /dev/null
+++ b/cpan/dist/PathTools/t/Functions.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+
+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'));
+is(curdir(), File::Spec->curdir());
+is(devnull(), File::Spec->devnull());
+is(rootdir(), File::Spec->rootdir());
+is(updir(), File::Spec->updir());
diff --git a/cpan/dist/PathTools/t/Spec-taint.t b/cpan/dist/PathTools/t/Spec-taint.t
new file mode 100644
index 00000000..ef4f1ee3
--- /dev/null
+++ b/cpan/dist/PathTools/t/Spec-taint.t
@@ -0,0 +1,17 @@
+#!./perl -Tw
+# Testing File::Spec under taint mode.
+
+use strict;
+
+chdir 't' unless $ENV{PERL_CORE};
+
+use File::Spec;
+use lib File::Spec->catdir('t', 'lib');
+use Test::More tests => 2;
+
+use Scalar::Util qw/tainted/;
+
+my $ret;
+eval { $ret = File::Spec->tmpdir };
+is( $@, '', "tmpdir should not explode under taint mode" );
+ok( !tainted($ret), "its return value should not be tainted" );
diff --git a/cpan/dist/PathTools/t/Spec.t b/cpan/dist/PathTools/t/Spec.t
new file mode 100644
index 00000000..74c18aac
--- /dev/null
+++ b/cpan/dist/PathTools/t/Spec.t
@@ -0,0 +1,841 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+require_ok('File::Spec');
+
+require Cwd;
+
+my $vms_unix_rpt;
+
+if ($^O eq 'VMS') {
+ if (eval 'require VMS::Feature') {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ }
+}
+
+
+my $skip_exception = "Needs VMS::Filespec (and thus VMS)" ;
+
+eval {
+ require VMS::Filespec ;
+} ;
+
+if ( $@ ) {
+ # Not pretty, but it allows testing of things not implemented solely
+ # on VMS. It might be better to change File::Spec::VMS to do this,
+ # making it more usable when running on (say) Unix but working with
+ # VMS paths.
+ eval qq-
+ sub File::Spec::VMS::vmsify { die "$skip_exception" }
+ sub File::Spec::VMS::unixify { die "$skip_exception" }
+ sub File::Spec::VMS::vmspath { die "$skip_exception" }
+ - ;
+ $INC{"VMS/Filespec.pm"} = 1 ;
+}
+
+foreach (qw(Unix Win32 VMS OS2 Mac Epoc Cygwin)) {
+ require_ok("File::Spec::$_");
+}
+
+# Each element in this array is a single test. Storing them this way makes
+# maintenance easy, and should be OK since perl should be pretty functional
+# before these tests are run.
+
+my @tests = (
+# [ Function , Expected , Platform ]
+
+[ "Unix->case_tolerant()", '0' ],
+
+[ "Unix->catfile('a','b','c')", 'a/b/c' ],
+[ "Unix->catfile('a','b','./c')", 'a/b/c' ],
+[ "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/,' ],
+[ "Unix->splitpath('d1/d2/d3/')", ',d1/d2/d3/,' ],
+[ "Unix->splitpath('/d1/d2/d3/.')", ',/d1/d2/d3/.,' ],
+[ "Unix->splitpath('/d1/d2/d3/..')", ',/d1/d2/d3/..,' ],
+[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ],
+[ "Unix->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ],
+[ "Unix->splitpath('/../../d1/')", ',/../../d1/,' ],
+[ "Unix->splitpath('/././d1/')", ',/././d1/,' ],
+
+[ "Unix->catpath('','','file')", 'file' ],
+[ "Unix->catpath('','/d1/d2/d3/','')", '/d1/d2/d3/' ],
+[ "Unix->catpath('','d1/d2/d3/','')", 'd1/d2/d3/' ],
+[ "Unix->catpath('','/d1/d2/d3/.','')", '/d1/d2/d3/.' ],
+[ "Unix->catpath('','/d1/d2/d3/..','')", '/d1/d2/d3/..' ],
+[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ],
+[ "Unix->catpath('','d1/d2/d3/','file')", 'd1/d2/d3/file' ],
+[ "Unix->catpath('','/../../d1/','')", '/../../d1/' ],
+[ "Unix->catpath('','/././d1/','')", '/././d1/' ],
+[ "Unix->catpath('d1','d2/d3/','')", 'd2/d3/' ],
+[ "Unix->catpath('d1','d2','d3/')", 'd2/d3/' ],
+
+[ "Unix->splitdir('')", '' ],
+[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ],
+[ "Unix->splitdir('d1/d2/d3/')", 'd1,d2,d3,' ],
+[ "Unix->splitdir('/d1/d2/d3')", ',d1,d2,d3' ],
+[ "Unix->splitdir('d1/d2/d3')", 'd1,d2,d3' ],
+
+[ "Unix->catdir()", '' ],
+[ "Unix->catdir('')", '/' ],
+[ "Unix->catdir('/')", '/' ],
+[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ],
+[ "Unix->catdir('d1','d2','d3','')", 'd1/d2/d3' ],
+[ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ],
+[ "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' ],
+[ "Unix->abs2rel('/t1/t2','/t1/t2/t3')", '..' ],
+[ "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ],
+[ "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')", '../../../t4/t5/t6' ],
+#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ],
+[ "Unix->abs2rel('/','/t1/t2/t3')", '../../..' ],
+[ "Unix->abs2rel('///','/t1/t2/t3')", '../../..' ],
+[ "Unix->abs2rel('/.','/t1/t2/t3')", '../../..' ],
+[ "Unix->abs2rel('/./','/t1/t2/t3')", '../../..' ],
+#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ],
+[ "Unix->abs2rel('/t1/t2/t3', '/')", 't1/t2/t3' ],
+[ "Unix->abs2rel('/t1/t2/t3', '/t1')", 't2/t3' ],
+[ "Unix->abs2rel('t1/t2/t3', 't1')", 't2/t3' ],
+[ "Unix->abs2rel('t1/t2/t3', 't4')", '../t1/t2/t3' ],
+ [ "Unix->abs2rel('.', '.')", '.' ],
+ [ "Unix->abs2rel('/', '/')", '.' ],
+ [ "Unix->abs2rel('../t1', 't2/t3')", '../../../t1' ],
+ [ "Unix->abs2rel('t1', 't2/../t3')", '../t1' ],
+
+[ "Unix->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ],
+[ "Unix->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ],
+[ "Unix->rel2abs('.','/t1/t2/t3')", '/t1/t2/t3' ],
+[ "Unix->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ],
+[ "Unix->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ],
+[ "Unix->rel2abs('/t1','/t1/t2/t3')", '/t1' ],
+
+[ "Win32->case_tolerant()", '1' ],
+[ "Win32->rootdir()", '\\' ],
+
+[ "Win32->splitpath('file')", ',,file' ],
+[ "Win32->splitpath('\\d1/d2\\d3/')", ',\\d1/d2\\d3/,' ],
+[ "Win32->splitpath('d1/d2\\d3/')", ',d1/d2\\d3/,' ],
+[ "Win32->splitpath('\\d1/d2\\d3/.')", ',\\d1/d2\\d3/.,' ],
+[ "Win32->splitpath('\\d1/d2\\d3/..')", ',\\d1/d2\\d3/..,' ],
+[ "Win32->splitpath('\\d1/d2\\d3/.file')", ',\\d1/d2\\d3/,.file' ],
+[ "Win32->splitpath('\\d1/d2\\d3/file')", ',\\d1/d2\\d3/,file' ],
+[ "Win32->splitpath('d1/d2\\d3/file')", ',d1/d2\\d3/,file' ],
+[ "Win32->splitpath('C:\\d1/d2\\d3/')", 'C:,\\d1/d2\\d3/,' ],
+[ "Win32->splitpath('C:d1/d2\\d3/')", 'C:,d1/d2\\d3/,' ],
+[ "Win32->splitpath('C:\\d1/d2\\d3/file')", 'C:,\\d1/d2\\d3/,file' ],
+[ "Win32->splitpath('C:d1/d2\\d3/file')", 'C:,d1/d2\\d3/,file' ],
+[ "Win32->splitpath('C:\\../d2\\d3/file')", 'C:,\\../d2\\d3/,file' ],
+[ "Win32->splitpath('C:../d2\\d3/file')", 'C:,../d2\\d3/,file' ],
+[ "Win32->splitpath('\\../..\\d1/')", ',\\../..\\d1/,' ],
+[ "Win32->splitpath('\\./.\\d1/')", ',\\./.\\d1/,' ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')", '\\\\node\\share,\\d1/d2\\d3/,' ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')", '\\\\node\\share,\\d1/d2\\,file' ],
+[ "Win32->splitpath('file',1)", ',file,' ],
+[ "Win32->splitpath('\\d1/d2\\d3/',1)", ',\\d1/d2\\d3/,' ],
+[ "Win32->splitpath('d1/d2\\d3/',1)", ',d1/d2\\d3/,' ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)", '\\\\node\\share,\\d1/d2\\d3/,' ],
+
+[ "Win32->catpath('','','file')", 'file' ],
+[ "Win32->catpath('','\\d1/d2\\d3/','')", '\\d1/d2\\d3/' ],
+[ "Win32->catpath('','d1/d2\\d3/','')", 'd1/d2\\d3/' ],
+[ "Win32->catpath('','\\d1/d2\\d3/.','')", '\\d1/d2\\d3/.' ],
+[ "Win32->catpath('','\\d1/d2\\d3/..','')", '\\d1/d2\\d3/..' ],
+[ "Win32->catpath('','\\d1/d2\\d3/','.file')", '\\d1/d2\\d3/.file' ],
+[ "Win32->catpath('','\\d1/d2\\d3/','file')", '\\d1/d2\\d3/file' ],
+[ "Win32->catpath('','d1/d2\\d3/','file')", 'd1/d2\\d3/file' ],
+[ "Win32->catpath('C:','\\d1/d2\\d3/','')", 'C:\\d1/d2\\d3/' ],
+[ "Win32->catpath('C:','d1/d2\\d3/','')", 'C:d1/d2\\d3/' ],
+[ "Win32->catpath('C:','\\d1/d2\\d3/','file')", 'C:\\d1/d2\\d3/file' ],
+[ "Win32->catpath('C:','d1/d2\\d3/','file')", 'C:d1/d2\\d3/file' ],
+[ "Win32->catpath('C:','\\../d2\\d3/','file')", 'C:\\../d2\\d3/file' ],
+[ "Win32->catpath('C:','../d2\\d3/','file')", 'C:../d2\\d3/file' ],
+[ "Win32->catpath('','\\../..\\d1/','')", '\\../..\\d1/' ],
+[ "Win32->catpath('','\\./.\\d1/','')", '\\./.\\d1/' ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')", '\\\\node\\share\\d1/d2\\d3/' ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')", '\\\\node\\share\\d1/d2\\file' ],
+
+[ "Win32->splitdir('')", '' ],
+[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ],
+[ "Win32->splitdir('d1/d2\\d3/')", 'd1,d2,d3,' ],
+[ "Win32->splitdir('\\d1/d2\\d3')", ',d1,d2,d3' ],
+[ "Win32->splitdir('d1/d2\\d3')", 'd1,d2,d3' ],
+
+[ "Win32->catdir()", '' ],
+[ "Win32->catdir('')", '\\' ],
+[ "Win32->catdir('/')", '\\' ],
+[ "Win32->catdir('/', '../')", '\\' ],
+[ "Win32->catdir('/', '..\\')", '\\' ],
+[ "Win32->catdir('\\', '../')", '\\' ],
+[ "Win32->catdir('\\', '..\\')", '\\' ],
+[ "Win32->catdir('//d1','d2')", '\\\\d1\\d2' ],
+[ "Win32->catdir('\\d1\\','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('\\d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('\\d1','\\d2')", '\\d1\\d2' ],
+[ "Win32->catdir('\\d1','\\d2\\')", '\\d1\\d2' ],
+[ "Win32->catdir('','/d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','','/d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','//d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','','//d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','d1','','d2','')", '\\d1\\d2' ],
+[ "Win32->catdir('','d1','d2','d3','')", '\\d1\\d2\\d3' ],
+[ "Win32->catdir('d1','d2','d3','')", 'd1\\d2\\d3' ],
+[ "Win32->catdir('','d1','d2','d3')", '\\d1\\d2\\d3' ],
+[ "Win32->catdir('d1','d2','d3')", 'd1\\d2\\d3' ],
+[ "Win32->catdir('A:/d1','d2','d3')", 'A:\\d1\\d2\\d3' ],
+[ "Win32->catdir('A:/d1','d2','d3','')", 'A:\\d1\\d2\\d3' ],
+#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3' ],
+[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ],
+[ "Win32->catdir('A:/')", 'A:\\' ],
+[ "Win32->catdir('\\', 'foo')", '\\foo' ],
+[ "Win32->catdir('','','..')", '\\' ],
+[ "Win32->catdir('A:', 'foo')", 'A:\\foo' ],
+
+[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
+[ "Win32->catfile('a','b','.\\c')", 'a\\b\\c' ],
+[ "Win32->catfile('.\\a','b','c')", 'a\\b\\c' ],
+[ "Win32->catfile('c')", 'c' ],
+[ "Win32->catfile('.\\c')", 'c' ],
+[ "Win32->catfile('a/..','../b')", '..\\b' ],
+[ "Win32->catfile('A:', 'foo')", 'A:\\foo' ],
+
+
+[ "Win32->canonpath('')", '' ],
+[ "Win32->canonpath('a:')", 'A:' ],
+[ "Win32->canonpath('A:f')", 'A:f' ],
+[ "Win32->canonpath('A:/')", 'A:\\' ],
+# rt.perl.org 27052
+[ "Win32->canonpath('a\\..\\..\\b\\c')", '..\\b\\c' ],
+[ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ],
+[ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ],
+[ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ],
+[ "Win32->canonpath('////')", '\\' ],
+[ "Win32->canonpath('//')", '\\' ],
+[ "Win32->canonpath('/.')", '\\' ],
+[ "Win32->canonpath('//a/b/../../c')", '\\\\a\\b\\c' ],
+[ "Win32->canonpath('//a/b/c/../d')", '\\\\a\\b\\d' ],
+[ "Win32->canonpath('//a/b/c/../../d')",'\\\\a\\b\\d' ],
+[ "Win32->canonpath('//a/b/c/.../d')", '\\\\a\\b\\d' ],
+[ "Win32->canonpath('/a/b/c/../../d')", '\\a\\d' ],
+[ "Win32->canonpath('/a/b/c/.../d')", '\\a\\d' ],
+[ "Win32->canonpath('\\../temp\\')", '\\temp' ],
+[ "Win32->canonpath('\\../')", '\\' ],
+[ "Win32->canonpath('\\..\\')", '\\' ],
+[ "Win32->canonpath('/../')", '\\' ],
+[ "Win32->canonpath('/..\\')", '\\' ],
+[ "Win32->canonpath('d1/../foo')", 'foo' ],
+
+# FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta
+
+[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ],
+[ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')", '..\\t4' ],
+[ "FakeWin32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ],
+[ "FakeWin32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ],
+[ "FakeWin32->abs2rel('/t4/t5/t6','/t1/t2/t3')", '..\\..\\..\\t4\\t5\\t6' ],
+[ "FakeWin32->abs2rel('../t4','/t1/t2/t3')", '..\\..\\..\\one\\t4' ], # Uses _cwd()
+[ "FakeWin32->abs2rel('/','/t1/t2/t3')", '..\\..\\..' ],
+[ "FakeWin32->abs2rel('///','/t1/t2/t3')", '..\\..\\..' ],
+[ "FakeWin32->abs2rel('/.','/t1/t2/t3')", '..\\..\\..' ],
+[ "FakeWin32->abs2rel('/./','/t1/t2/t3')", '..\\..\\..' ],
+[ "FakeWin32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ],
+[ "FakeWin32->abs2rel('//a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ],
+[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')", '.' ],
+[ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','A:/t1/t2/t3')", 't4' ],
+[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3/t4')", '..' ],
+[ "FakeWin32->abs2rel('A:/t1/t2/t3','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3' ],
+[ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3\\t4' ],
+[ "FakeWin32->abs2rel('E:/foo/bar/baz')", 'E:\\foo\\bar\\baz' ],
+[ "FakeWin32->abs2rel('C:/one/two/three')", 'three' ],
+[ "FakeWin32->abs2rel('C:\\Windows\\System32', 'C:\\')", 'Windows\System32' ],
+[ "FakeWin32->abs2rel('\\\\computer2\\share3\\foo.txt', '\\\\computer2\\share3')", 'foo.txt' ],
+[ "FakeWin32->abs2rel('C:\\one\\two\\t\\asd1\\', 't\\asd\\')", '..\\asd1' ],
+[ "FakeWin32->abs2rel('\\one\\two', 'A:\\foo')", 'C:\\one\\two' ],
+
+[ "FakeWin32->rel2abs('temp','C:/')", 'C:\\temp' ],
+[ "FakeWin32->rel2abs('temp','C:/a')", 'C:\\a\\temp' ],
+[ "FakeWin32->rel2abs('temp','C:/a/')", 'C:\\a\\temp' ],
+[ "FakeWin32->rel2abs('../','C:/')", 'C:\\' ],
+[ "FakeWin32->rel2abs('../','C:/a')", 'C:\\' ],
+[ "FakeWin32->rel2abs('\\foo','C:/a')", 'C:\\foo' ],
+[ "FakeWin32->rel2abs('temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ],
+[ "FakeWin32->rel2abs('../temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ],
+[ "FakeWin32->rel2abs('temp','//prague_main/work')", '\\\\prague_main\\work\\temp' ],
+[ "FakeWin32->rel2abs('../','//prague_main/work')", '\\\\prague_main\\work' ],
+[ "FakeWin32->rel2abs('D:foo.txt')", 'D:\\alpha\\beta\\foo.txt' ],
+
+[ "VMS->case_tolerant()", '1' ],
+
+[ "VMS->catfile('a','b','c')", $vms_unix_rpt ? 'a/b/c' : '[.a.b]c' ],
+[ "VMS->catfile('a','b','[]c')", $vms_unix_rpt ? 'a/b/c' : '[.a.b]c' ],
+[ "VMS->catfile('[.a]','b','c')", $vms_unix_rpt ? 'a/b/c' : '[.a.b]c' ],
+[ "VMS->catfile('a/b/','c')", $vms_unix_rpt ? 'a/b/c' : '[.a.b]c' ],
+[ "VMS->catfile('c')", 'c' ],
+[ "VMS->catfile('[]c')", 'c' ],
+
+[ "VMS->catfile('0','b','c')", $vms_unix_rpt ? '0/b/c' : '[.0.b]c' ],
+[ "VMS->catfile('a','0','c')", $vms_unix_rpt ? 'a/0/c' : '[.a.0]c' ],
+[ "VMS->catfile('a','b','0')", $vms_unix_rpt ? 'a/b/0' : '[.a.b]0' ],
+[ "VMS->catfile('0','0','c')", $vms_unix_rpt ? '0/0/c' : '[.0.0]c' ],
+[ "VMS->catfile('a','0','0')", $vms_unix_rpt ? 'a/0/0' : '[.a.0]0' ],
+[ "VMS->catfile('0','b','0')", $vms_unix_rpt ? '0/b/0' : '[.0.b]0' ],
+[ "VMS->catfile('0','0','0')", $vms_unix_rpt ? '0/0/0' : '[.0.0]0' ],
+
+
+[ "VMS->splitpath('file')", ',,file' ],
+[ "VMS->splitpath('[d1.d2.d3]')", ',[d1.d2.d3],' ],
+[ "VMS->splitpath('[.d1.d2.d3]')", ',[.d1.d2.d3],' ],
+[ "VMS->splitpath('[d1.d2.d3]file')", ',[d1.d2.d3],file' ],
+[ "VMS->splitpath('d1/d2/d3/file')",
+ $vms_unix_rpt ? ',d1/d2/d3/,file' : ',[.d1.d2.d3],file' ],
+[ "VMS->splitpath('/d1/d2/d3/file')",
+ $vms_unix_rpt ? ',/d1/d2/d3/,file' : 'd1:,[d2.d3],file' ],
+[ "VMS->splitpath('[.d1.d2.d3]file')", ',[.d1.d2.d3],file' ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]')", 'node::volume:,[d1.d2.d3],' ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]file')", 'node::volume:,[d1.d2.d3],file' ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')", 'node"access_spec"::volume:,[d1.d2.d3],' ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ],
+
+[ "VMS->splitpath('[]')", ',[],' ],
+[ "VMS->splitpath('[-]')", ',[-],' ],
+[ "VMS->splitpath('[]file')", ',[],file' ],
+[ "VMS->splitpath('[-]file')", ',[-],file' ],
+[ "VMS->splitpath('')", ',,' ],
+[ "VMS->splitpath('0')", ',,0' ],
+[ "VMS->splitpath('[0]')", ',[0],' ],
+[ "VMS->splitpath('[.0]')", ',[.0],' ],
+[ "VMS->splitpath('[0.0.0]')", ',[0.0.0],' ],
+[ "VMS->splitpath('[.0.0.0]')", ',[.0.0.0],' ],
+[ "VMS->splitpath('[0]0')", ',[0],0' ],
+[ "VMS->splitpath('[0.0.0]0')", ',[0.0.0],0' ],
+[ "VMS->splitpath('[.0.0.0]0')", ',[.0.0.0],0' ],
+[ "VMS->splitpath('0/0')", $vms_unix_rpt ? ',0/,0' : ',[.0],0' ],
+[ "VMS->splitpath('0/0/0')", $vms_unix_rpt ? ',0/0/,0' : ',[.0.0],0' ],
+[ "VMS->splitpath('/0/0')", $vms_unix_rpt ? ',/0/,0' : '0:,[000000],0' ],
+[ "VMS->splitpath('/0/0/0')", $vms_unix_rpt ? ',/0/0/,0' : '0:,[0],0' ],
+[ "VMS->splitpath('d1',1)", ',d1,' ],
+# $no_file tests
+[ "VMS->splitpath('[d1.d2.d3]',1)", ',[d1.d2.d3],' ],
+[ "VMS->splitpath('[.d1.d2.d3]',1)", ',[.d1.d2.d3],' ],
+[ "VMS->splitpath('d1/d2/d3',1)", $vms_unix_rpt ? ',d1/d2/d3,' : ',[.d1.d2.d3],' ],
+[ "VMS->splitpath('/d1/d2/d3',1)", $vms_unix_rpt ? ',/d1/d2/d3,' : 'd1:,[d2.d3],' ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]',1)", 'node::volume:,[d1.d2.d3],' ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]',1)", 'node"access_spec"::volume:,[d1.d2.d3],' ],
+[ "VMS->splitpath('[]',1)", ',[],' ],
+[ "VMS->splitpath('[-]',1)", ',[-],' ],
+[ "VMS->splitpath('',1)", ',,' ],
+[ "VMS->splitpath('0',1)", ',0,' ],
+[ "VMS->splitpath('[0]',1)", ',[0],' ],
+[ "VMS->splitpath('[.0]',1)", ',[.0],' ],
+[ "VMS->splitpath('[0.0.0]',1)", ',[0.0.0],' ],
+[ "VMS->splitpath('[.0.0.0]',1)", ',[.0.0.0],' ],
+[ "VMS->splitpath('0/0',1)", $vms_unix_rpt ? ',0/0,' : ',[.0.0],' ],
+[ "VMS->splitpath('0/0/0',1)", $vms_unix_rpt ? ',0/0/0,' : ',[.0.0.0],' ],
+[ "VMS->splitpath('/0/0',1)", $vms_unix_rpt ? ',/0/0,' : '0:,[000000.0],' ],
+[ "VMS->splitpath('/0/0/0',1)", $vms_unix_rpt ? ',/0/0/0,' : '0:,[0.0],' ],
+
+[ "VMS->catpath('','','file')", 'file' ],
+[ "VMS->catpath('','[d1.d2.d3]','')", '[d1.d2.d3]' ],
+[ "VMS->catpath('','[.d1.d2.d3]','')", '[.d1.d2.d3]' ],
+[ "VMS->catpath('','[d1.d2.d3]','file')", '[d1.d2.d3]file' ],
+[ "VMS->catpath('','[.d1.d2.d3]','file')", '[.d1.d2.d3]file' ],
+[ "VMS->catpath('','d1/d2/d3','file')",
+ $vms_unix_rpt ? 'd1/d2/d3/file' : '[.d1.d2.d3]file' ],
+[ "VMS->catpath('v','d1/d2/d3','file')", 'v:[.d1.d2.d3]file' ],
+[ "VMS->catpath('v','','file')", 'v:file' ],
+[ "VMS->catpath('v','w:[d1.d2.d3]','file')", 'v:[d1.d2.d3]file' ],
+[ "VMS->catpath('node::volume:','[d1.d2.d3]','')", 'node::volume:[d1.d2.d3]' ],
+[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')", 'node::volume:[d1.d2.d3]file' ],
+[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')", 'node"access_spec"::volume:[d1.d2.d3]' ],
+[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ],
+
+[ "VMS->canonpath('')", '' ],
+[ "VMS->canonpath('volume:[d1]file')", $vms_unix_rpt ? '/volume/d1/file' : 'volume:[d1]file' ],
+[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", $vms_unix_rpt ? '/volume/d2/d3/' : 'volume:[d2.d3]' ],
+[ "VMS->canonpath('volume:[000000.d1]d2.dir;1')", $vms_unix_rpt ? '/volume/d1/d2.dir.1' : 'volume:[d1]d2.dir;1' ],
+[ "VMS->canonpath('volume:[d1.d2.d3]file.txt')", $vms_unix_rpt ? '/volume/d1/d2/d3/file.txt' : 'volume:[d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('[d1.d2.d3]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/d2/d3/file.txt' : '[d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[-.d1.d2.d3]file.txt')", $vms_unix_rpt ? '/volume/../d1/d2/d3/file.txt' : 'volume:[-.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('[-.d1.d2.d3]file.txt')", $vms_unix_rpt ? '../d1/d2/d3/file.txt' : '[-.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[--.d1.d2.d3]file.txt')", $vms_unix_rpt ? '/volume/../../d1/d2/d3/file.txt' : 'volume:[--.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('[--.d1.d2.d3]file.txt')", $vms_unix_rpt ? '../../d1/d2/d3/file.txt' : '[--.d1.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.-.d2.d3]file.txt')", $vms_unix_rpt ? '/volume/d2/d3/file.txt' : 'volume:[d2.d3]file.txt' ],
+[ "VMS->canonpath('[d1.-.d2.d3]file.txt')", $vms_unix_rpt ? '/sys$disk/d2/d3/file.txt' : '[d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.--.d2.d3]file.txt')", $vms_unix_rpt ? '/volume/../d2/d3/file.txt' : 'volume:[-.d2.d3]file.txt' ],
+[ "VMS->canonpath('[d1.--.d2.d3]file.txt')", $vms_unix_rpt ? '../d2/d3/file.txt' : '[-.d2.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.-.d3]file.txt')", $vms_unix_rpt ? '/volume/d1/d3/file.txt' : 'volume:[d1.d3]file.txt' ],
+[ "VMS->canonpath('[d1.d2.-.d3]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/d3/file.txt' : '[d1.d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.--.d3]file.txt')", $vms_unix_rpt ? '/volume/d3/file.txt' : 'volume:[d3]file.txt' ],
+[ "VMS->canonpath('[d1.d2.--.d3]file.txt')", $vms_unix_rpt ? '/sys$disk/d3/file.txt' : '[d3]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.d3.-]file.txt')", $vms_unix_rpt ? '/volume/d1/d2/file.txt' : 'volume:[d1.d2]file.txt' ],
+[ "VMS->canonpath('[d1.d2.d3.-]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/d2/file.txt' : '[d1.d2]file.txt' ],
+[ "VMS->canonpath('volume:[d1.d2.d3.--]file.txt')", $vms_unix_rpt ? '/volume/d1/file.txt' : 'volume:[d1]file.txt' ],
+[ "VMS->canonpath('[d1.d2.d3.--]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/file.txt' : '[d1]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][d3.--]file.txt')", $vms_unix_rpt ? '/volume/d1/file.txt'
+ : 'volume:[d1]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][d3.--]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/file.txt'
+ : '[d1]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][d2.000000]file.txt')", $vms_unix_rpt ? '/volume/d1/000000/d2/000000/file.txt'
+ : 'volume:[d1.000000.d2.000000]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][d2.000000]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/000000/d2/000000/file.txt'
+ : '[d1.000000.d2.000000]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][d3.--.000000]file.txt')", $vms_unix_rpt ? '/volume/d1/000000/file.txt'
+ : 'volume:[d1.000000]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][d3.--.000000]file.txt')", $vms_unix_rpt ? '/sys$disk/d1/000000/file.txt'
+ : '[d1.000000]file.txt' ],
+[ "VMS->canonpath('volume:[d1.000000.][000000.][-.-.000000]file.txt')", $vms_unix_rpt ? '/volume/file.txt'
+ : 'volume:[000000]file.txt' ],
+[ "VMS->canonpath('[d1.000000.][000000.][--.-.000000]file.txt')", $vms_unix_rpt ? '../file.txt' : '[-.000000]file.txt' ],
+[ "VMS->canonpath('[d1.d2.--]file')", $vms_unix_rpt ? '../file.txt' : '[000000]file' ],
+# During the Perl 5.8 era, FS::Unix stopped eliminating redundant path elements, so mimic that here.
+[ "VMS->canonpath('a/../../b/c.dat')", $vms_unix_rpt ? 'a/../../b/c.dat' : '[-.b]c.dat' ],
+[ "VMS->canonpath('^<test^.new.-.caret^ escapes^>')", '^<test^.new.-.caret^ escapes^>' ],
+
+[ "VMS->splitdir('')", '' ],
+[ "VMS->splitdir('[]')", '' ],
+[ "VMS->splitdir('d1.d2.d3')", 'd1,d2,d3' ],
+[ "VMS->splitdir('[d1.d2.d3]')", 'd1,d2,d3' ],
+[ "VMS->splitdir('.d1.d2.d3')", 'd1,d2,d3' ],
+[ "VMS->splitdir('[.d1.d2.d3]')", 'd1,d2,d3' ],
+[ "VMS->splitdir('.-.d2.d3')", '-,d2,d3' ],
+[ "VMS->splitdir('[.-.d2.d3]')", '-,d2,d3' ],
+[ "VMS->splitdir('[d1.d2]')", 'd1,d2' ],
+[ "VMS->splitdir('[d1-.--d2]')", 'd1-,--d2' ],
+[ "VMS->splitdir('[d1---.-.d2]')", 'd1---,-,d2' ],
+[ "VMS->splitdir('[d1.---.d2]')", 'd1,-,-,-,d2' ],
+[ "VMS->splitdir('[d1---d2]')", 'd1---d2' ],
+[ "VMS->splitdir('[d1.][000000.d2]')", 'd1,d2' ],
+[ "VMS->splitdir('[.d1.d2^.d3]')", 'd1,d2^.d3' ],
+
+[ "VMS->catdir('')", '' ],
+[ "VMS->catdir('foo')", $vms_unix_rpt ? 'foo' : '[.foo]' ],
+[ "VMS->catdir('d1','d2','d3')", $vms_unix_rpt ? 'd1/d2/d3' : '[.d1.d2.d3]' ],
+[ "VMS->catdir('d1','d2/','d3')", $vms_unix_rpt ? 'd1/d2/d3' : '[.d1.d2.d3]' ],
+[ "VMS->catdir('','d1','d2','d3')",$vms_unix_rpt ? '/d1/d2/d3' : '[.d1.d2.d3]' ],
+[ "VMS->catdir('','-','d2','d3')", $vms_unix_rpt ? '-/d2/d3' : '[-.d2.d3]' ],
+[ "VMS->catdir('','-','','d3')", $vms_unix_rpt ? '-/d3' : '[-.d3]' ],
+[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", $vms_unix_rpt ? 'dir/d2/d3'
+ : '[.dir.d2.d3]' ],
+[ "VMS->catdir('[.name]')", $vms_unix_rpt ? 'name/' : '[.name]' ],
+[ "VMS->catdir('[.name]','[.name]')", $vms_unix_rpt ? 'name/name' :'[.name.name]' ],
+[ "VMS->catdir('/a/b/c','[-]')", $vms_unix_rpt ? '/a/b/c/..' : 'a:[b]'],
+[ "VMS->catdir('a:[b.c]','..')", $vms_unix_rpt ? '/a/b/c/..' : 'a:[b]'],
+
+[ "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", $vms_unix_rpt ? './' : '[]' ],
+[ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", $vms_unix_rpt ? '/node//volume/t1/t2/t3/' : 'node::volume:[t1.t2.t3]' ],
+[ "VMS->abs2rel('node::volume:[t1.t2.t4]','node::volume:[t1.t2.t3]')", $vms_unix_rpt ? '../t4/' : '[-.t4]' ],
+[ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/node//volume/t1/t2/t4/' : 'node::volume:[t1.t2.t4]' ],
+[ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", $vms_unix_rpt ? './' : '[]' ],
+[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ],
+[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2]')", $vms_unix_rpt ? 't3/file' : '[.t3]file' ],
+[ "VMS->abs2rel('v:[t1.t2.t3]file','v:[t1.t2]')", $vms_unix_rpt ? 't3/file' : '[.t3]file' ],
+[ "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '../t4/' : '[-.t4]' ],
+[ "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')", $vms_unix_rpt ? '../file' : '[-]file' ],
+[ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", $vms_unix_rpt ? 't4/' : '[.t4]' ],
+[ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", $vms_unix_rpt ? '../../../t4/t5/t6/' : '[---.t4.t5.t6]' ],
+[ "VMS->abs2rel('[000000]','[t1.t2.t3]')", $vms_unix_rpt ? '../../../' : '[---]' ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')", $vms_unix_rpt ? '../t4/' : '[-.t4]' ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/a/t1/t2/t4/' : 'a:[t1.t2.t4]' ],
+[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", $vms_unix_rpt ? '../../../b/' : '[---.b]' ],
+
+[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/t2/t3/t4/' : '[t1.t2.t3.t4]' ],
+[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/t2/t3/t4/t5/' : '[t1.t2.t3.t4.t5]' ],
+[ "VMS->rel2abs('[]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/t2/t3/' : '[t1.t2.t3]' ],
+[ "VMS->rel2abs('[-]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/t2/' : '[t1.t2]' ],
+[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/t2/t4/' : '[t1.t2.t4]' ],
+[ "VMS->rel2abs('[t1]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/' : '[t1]' ],
+
+[ "VMS->file_name_is_absolute('foo:')", '1' ],
+[ "VMS->file_name_is_absolute('foo:bar.dat')", '1' ],
+[ "VMS->file_name_is_absolute('foo:[000000]bar.dat')", '1' ],
+
+[ "OS2->case_tolerant()", '1' ],
+
+[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],
+
+[ "OS2->catfile('a','b','c')", 'a/b/c' ],
+[ "OS2->catfile('a','b','./c')", 'a/b/c' ],
+[ "OS2->catfile('./a','b','c')", 'a/b/c' ],
+[ "OS2->catfile('c')", 'c' ],
+[ "OS2->catfile('./c')", 'c' ],
+
+[ "OS2->catdir('/', '../')", '/' ],
+[ "OS2->catdir('/', '..\\')", '/' ],
+[ "OS2->catdir('\\', '../')", '/' ],
+[ "OS2->catdir('\\', '..\\')", '/' ],
+
+[ "Mac->case_tolerant()", '1' ],
+
+[ "Mac->catpath('','','')", '' ],
+[ "Mac->catpath('',':','')", ':' ],
+[ "Mac->catpath('','::','')", '::' ],
+
+[ "Mac->catpath('hd','','')", 'hd:' ],
+[ "Mac->catpath('hd:','','')", 'hd:' ],
+[ "Mac->catpath('hd:',':','')", 'hd:' ],
+[ "Mac->catpath('hd:','::','')", 'hd::' ],
+
+[ "Mac->catpath('hd','','file')", 'hd:file' ],
+[ "Mac->catpath('hd',':','file')", 'hd:file' ],
+[ "Mac->catpath('hd','::','file')", 'hd::file' ],
+[ "Mac->catpath('hd',':::','file')", 'hd:::file' ],
+
+[ "Mac->catpath('hd:','',':file')", 'hd:file' ],
+[ "Mac->catpath('hd:',':',':file')", 'hd:file' ],
+[ "Mac->catpath('hd:','::',':file')", 'hd::file' ],
+[ "Mac->catpath('hd:',':::',':file')", 'hd:::file' ],
+
+[ "Mac->catpath('hd:','d1','file')", 'hd:d1:file' ],
+[ "Mac->catpath('hd:',':d1:',':file')", 'hd:d1:file' ],
+[ "Mac->catpath('hd:','hd:d1','')", 'hd:d1:' ],
+
+[ "Mac->catpath('','d1','')", ':d1:' ],
+[ "Mac->catpath('',':d1','')", ':d1:' ],
+[ "Mac->catpath('',':d1:','')", ':d1:' ],
+
+[ "Mac->catpath('','d1','file')", ':d1:file' ],
+[ "Mac->catpath('',':d1:',':file')", ':d1:file' ],
+
+[ "Mac->catpath('','','file')", 'file' ],
+[ "Mac->catpath('','',':file')", 'file' ], # !
+[ "Mac->catpath('',':',':file')", ':file' ], # !
+
+
+[ "Mac->splitpath(':')", ',:,' ],
+[ "Mac->splitpath('::')", ',::,' ],
+[ "Mac->splitpath(':::')", ',:::,' ],
+
+[ "Mac->splitpath('file')", ',,file' ],
+[ "Mac->splitpath(':file')", ',:,file' ],
+
+[ "Mac->splitpath('d1',1)", ',:d1:,' ], # dir, not volume
+[ "Mac->splitpath(':d1',1)", ',:d1:,' ],
+[ "Mac->splitpath(':d1:',1)", ',:d1:,' ],
+[ "Mac->splitpath(':d1:')", ',:d1:,' ],
+[ "Mac->splitpath(':d1:d2:d3:')", ',:d1:d2:d3:,' ],
+[ "Mac->splitpath(':d1:d2:d3:',1)", ',:d1:d2:d3:,' ],
+[ "Mac->splitpath(':d1:file')", ',:d1:,file' ],
+[ "Mac->splitpath('::d1:file')", ',::d1:,file' ],
+
+[ "Mac->splitpath('hd:', 1)", 'hd:,,' ],
+[ "Mac->splitpath('hd:')", 'hd:,,' ],
+[ "Mac->splitpath('hd:d1:d2:')", 'hd:,:d1:d2:,' ],
+[ "Mac->splitpath('hd:d1:d2',1)", 'hd:,:d1:d2:,' ],
+[ "Mac->splitpath('hd:d1:d2:file')", 'hd:,:d1:d2:,file' ],
+[ "Mac->splitpath('hd:d1:d2::file')", 'hd:,:d1:d2::,file' ],
+[ "Mac->splitpath('hd::d1:d2:file')", 'hd:,::d1:d2:,file' ], # invalid path
+[ "Mac->splitpath('hd:file')", 'hd:,,file' ],
+
+[ "Mac->splitdir()", '' ],
+[ "Mac->splitdir('')", '' ],
+[ "Mac->splitdir(':')", ':' ],
+[ "Mac->splitdir('::')", '::' ],
+[ "Mac->splitdir(':::')", '::,::' ],
+[ "Mac->splitdir(':::d1:d2')", '::,::,d1,d2' ],
+
+[ "Mac->splitdir(':d1:d2:d3::')", 'd1,d2,d3,::'],
+[ "Mac->splitdir(':d1:d2:d3:')", 'd1,d2,d3' ],
+[ "Mac->splitdir(':d1:d2:d3')", 'd1,d2,d3' ],
+
+# absolute paths in splitdir() work, but you'd better use splitpath()
+[ "Mac->splitdir('hd:')", 'hd:' ],
+[ "Mac->splitdir('hd::')", 'hd:,::' ], # invalid path, but it works
+[ "Mac->splitdir('hd::d1:')", 'hd:,::,d1' ], # invalid path, but it works
+[ "Mac->splitdir('hd:d1:d2:::')", 'hd:,d1,d2,::,::' ],
+[ "Mac->splitdir('hd:d1:d2::')", 'hd:,d1,d2,::' ],
+[ "Mac->splitdir('hd:d1:d2:')", 'hd:,d1,d2' ],
+[ "Mac->splitdir('hd:d1:d2')", 'hd:,d1,d2' ],
+[ "Mac->splitdir('hd:d1::d2::')", 'hd:,d1,::,d2,::' ],
+
+[ "Mac->catdir()", '' ],
+[ "Mac->catdir(':')", ':' ],
+
+[ "Mac->catdir(':', ':')", ':' ],
+[ "Mac->catdir(':', '')", ':' ],
+
+[ "Mac->catdir(':', '::')", '::' ],
+
+[ "Mac->catdir('::', '')", '::' ],
+[ "Mac->catdir('::', ':')", '::' ],
+
+[ "Mac->catdir('::', '::')", ':::' ],
+
+[ "Mac->catdir(':d1')", ':d1:' ],
+[ "Mac->catdir(':d1:')", ':d1:' ],
+[ "Mac->catdir(':d1','d2')", ':d1:d2:' ],
+[ "Mac->catdir(':d1',':d2')", ':d1:d2:' ],
+[ "Mac->catdir(':d1',':d2:')", ':d1:d2:' ],
+[ "Mac->catdir(':d1',':d2::')", ':d1:d2::' ],
+[ "Mac->catdir(':',':d1',':d2')", ':d1:d2:' ],
+[ "Mac->catdir('::',':d1',':d2')", '::d1:d2:' ],
+[ "Mac->catdir('::','::',':d1',':d2')", ':::d1:d2:' ],
+[ "Mac->catdir(':',':',':d1',':d2')", ':d1:d2:' ],
+[ "Mac->catdir('::',':',':d1',':d2')", '::d1:d2:' ],
+
+[ "Mac->catdir('d1')", ':d1:' ],
+[ "Mac->catdir('d1','d2','d3')", ':d1:d2:d3:' ],
+[ "Mac->catdir('d1','d2/','d3')", ':d1:d2/:d3:' ],
+[ "Mac->catdir('d1','',':d2')", ':d1:d2:' ],
+[ "Mac->catdir('d1',':',':d2')", ':d1:d2:' ],
+[ "Mac->catdir('d1','::',':d2')", ':d1::d2:' ],
+[ "Mac->catdir('d1',':::',':d2')", ':d1:::d2:' ],
+[ "Mac->catdir('d1','::','::',':d2')", ':d1:::d2:' ],
+[ "Mac->catdir('d1','d2')", ':d1:d2:' ],
+[ "Mac->catdir('d1','d2', '')", ':d1:d2:' ],
+[ "Mac->catdir('d1','d2', ':')", ':d1:d2:' ],
+[ "Mac->catdir('d1','d2', '::')", ':d1:d2::' ],
+[ "Mac->catdir('d1','d2','','')", ':d1:d2:' ],
+[ "Mac->catdir('d1','d2',':','::')", ':d1:d2::' ],
+[ "Mac->catdir('d1','d2','::','::')", ':d1:d2:::' ],
+[ "Mac->catdir('d1',':d2')", ':d1:d2:' ],
+[ "Mac->catdir('d1',':d2:')", ':d1:d2:' ],
+
+[ "Mac->catdir('hd:',':d1')", 'hd:d1:' ],
+[ "Mac->catdir('hd:d1:',':d2')", 'hd:d1:d2:' ],
+[ "Mac->catdir('hd:','d1')", 'hd:d1:' ],
+[ "Mac->catdir('hd:d1:',':d2')", 'hd:d1:d2:' ],
+[ "Mac->catdir('hd:d1:',':d2:')", 'hd:d1:d2:' ],
+
+[ "Mac->catfile()", '' ],
+[ "Mac->catfile('')", '' ],
+[ "Mac->catfile(':')", ':' ],
+[ "Mac->catfile(':', '')", ':' ],
+
+[ "Mac->catfile('d1','d2','file')", ':d1:d2:file' ],
+[ "Mac->catfile('d1','d2',':file')", ':d1:d2:file' ],
+[ "Mac->catfile('file')", 'file' ],
+[ "Mac->catfile(':', 'file')", ':file' ],
+
+[ "Mac->canonpath('')", '' ],
+[ "Mac->canonpath(':')", ':' ],
+[ "Mac->canonpath('::')", '::' ],
+[ "Mac->canonpath('a::')", 'a::' ],
+[ "Mac->canonpath(':a::')", ':a::' ],
+
+[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:')", ':' ],
+[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:file')", ':' ], # ignore base's file portion
+[ "Mac->abs2rel('hd:d1:d2:file','hd:d1:d2:')", ':file' ],
+[ "Mac->abs2rel('hd:d1:','hd:d1:d2:')", '::' ],
+[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')", ':::d3:' ],
+[ "Mac->abs2rel('hd:d3:','hd:d1:d2::')", '::d3:' ],
+[ "Mac->abs2rel('hd:d1:d4:d5:','hd:d1::d2:d3::')", '::d1:d4:d5:' ],
+[ "Mac->abs2rel('hd:d1:d4:d5:','hd:d1::d2:d3:')", ':::d1:d4:d5:' ], # first, resolve updirs in base
+[ "Mac->abs2rel('hd:d1:d3:','hd:d1:d2:')", '::d3:' ],
+[ "Mac->abs2rel('hd:d1::d3:','hd:d1:d2:')", ':::d3:' ],
+[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')", ':::d3:' ], # same as above
+[ "Mac->abs2rel('hd:d1:d2:d3:','hd:d1:d2:')", ':d3:' ],
+[ "Mac->abs2rel('hd:d1:d2:d3::','hd:d1:d2:')", ':d3::' ],
+[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')", 'hd1:d3:d4:d5:'], # volume mismatch
+[ "Mac->abs2rel('hd:','hd:d1:d2:')", ':::' ],
+
+[ "Mac->rel2abs(':d3:','hd:d1:d2:')", 'hd:d1:d2:d3:' ],
+[ "Mac->rel2abs(':d3:d4:','hd:d1:d2:')", 'hd:d1:d2:d3:d4:' ],
+[ "Mac->rel2abs('','hd:d1:d2:')", '' ],
+[ "Mac->rel2abs('::','hd:d1:d2:')", 'hd:d1:d2::' ],
+[ "Mac->rel2abs('::','hd:d1:d2:file')", 'hd:d1:d2::' ],# ignore base's file portion
+[ "Mac->rel2abs(':file','hd:d1:d2:')", 'hd:d1:d2:file' ],
+[ "Mac->rel2abs('::file','hd:d1:d2:')", 'hd:d1:d2::file' ],
+[ "Mac->rel2abs('::d3:','hd:d1:d2:')", 'hd:d1:d2::d3:' ],
+[ "Mac->rel2abs('hd:','hd:d1:d2:')", 'hd:' ], # path already absolute
+[ "Mac->rel2abs('hd:d3:file','hd:d1:d2:')", 'hd:d3:file' ],
+[ "Mac->rel2abs('hd:d3:','hd:d1:file')", 'hd:d3:' ],
+
+[ "Epoc->case_tolerant()", '1' ],
+
+[ "Epoc->canonpath('')", '' ],
+[ "Epoc->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ],
+[ "Epoc->canonpath('/./')", '/' ],
+[ "Epoc->canonpath('/a/./')", '/a' ],
+
+# XXX Todo, copied from Unix, but fail. Should they? 2003-07-07 Tels
+#[ "Epoc->canonpath('/a/.')", '/a' ],
+#[ "Epoc->canonpath('/.')", '/' ],
+
+[ "Cygwin->case_tolerant()", '1' ],
+[ "Cygwin->catfile('a','b','c')", 'a/b/c' ],
+[ "Cygwin->catfile('a','b','./c')", 'a/b/c' ],
+[ "Cygwin->catfile('./a','b','c')", 'a/b/c' ],
+[ "Cygwin->catfile('c')", 'c' ],
+[ "Cygwin->catfile('./c')", 'c' ],
+
+[ "Cygwin->splitpath('file')", ',,file' ],
+[ "Cygwin->splitpath('/d1/d2/d3/')", ',/d1/d2/d3/,' ],
+[ "Cygwin->splitpath('d1/d2/d3/')", ',d1/d2/d3/,' ],
+[ "Cygwin->splitpath('/d1/d2/d3/.')", ',/d1/d2/d3/.,' ],
+[ "Cygwin->splitpath('/d1/d2/d3/..')", ',/d1/d2/d3/..,' ],
+[ "Cygwin->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ],
+[ "Cygwin->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ],
+[ "Cygwin->splitpath('/../../d1/')", ',/../../d1/,' ],
+[ "Cygwin->splitpath('/././d1/')", ',/././d1/,' ],
+
+[ "Cygwin->catpath('','','file')", 'file' ],
+[ "Cygwin->catpath('','/d1/d2/d3/','')", '/d1/d2/d3/' ],
+[ "Cygwin->catpath('','d1/d2/d3/','')", 'd1/d2/d3/' ],
+[ "Cygwin->catpath('','/d1/d2/d3/.','')", '/d1/d2/d3/.' ],
+[ "Cygwin->catpath('','/d1/d2/d3/..','')", '/d1/d2/d3/..' ],
+[ "Cygwin->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ],
+[ "Cygwin->catpath('','d1/d2/d3/','file')", 'd1/d2/d3/file' ],
+[ "Cygwin->catpath('','/../../d1/','')", '/../../d1/' ],
+[ "Cygwin->catpath('','/././d1/','')", '/././d1/' ],
+[ "Cygwin->catpath('d1','d2/d3/','')", 'd2/d3/' ],
+[ "Cygwin->catpath('d1','d2','d3/')", 'd2/d3/' ],
+
+[ "Cygwin->splitdir('')", '' ],
+[ "Cygwin->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ],
+[ "Cygwin->splitdir('d1/d2/d3/')", 'd1,d2,d3,' ],
+[ "Cygwin->splitdir('/d1/d2/d3')", ',d1,d2,d3' ],
+[ "Cygwin->splitdir('d1/d2/d3')", 'd1,d2,d3' ],
+
+[ "Cygwin->catdir()", '' ],
+[ "Cygwin->catdir('/')", '/' ],
+[ "Cygwin->catdir('','d1','d2','d3','')", '/d1/d2/d3' ],
+[ "Cygwin->catdir('d1','d2','d3','')", 'd1/d2/d3' ],
+[ "Cygwin->catdir('','d1','d2','d3')", '/d1/d2/d3' ],
+[ "Cygwin->catdir('d1','d2','d3')", 'd1/d2/d3' ],
+[ "Cygwin->catdir('/','d2/d3')", '/d2/d3' ],
+
+[ "Cygwin->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ],
+[ "Cygwin->canonpath('')", '' ],
+[ "Cygwin->canonpath('a/../../b/c')", 'a/../../b/c' ],
+[ "Cygwin->canonpath('/.')", '/' ],
+[ "Cygwin->canonpath('/./')", '/' ],
+[ "Cygwin->canonpath('/a/./')", '/a' ],
+[ "Cygwin->canonpath('/a/.')", '/a' ],
+[ "Cygwin->canonpath('/../../')", '/' ],
+[ "Cygwin->canonpath('/../..')", '/' ],
+
+[ "Cygwin->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ],
+[ "Cygwin->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ],
+[ "Cygwin->abs2rel('/t1/t2','/t1/t2/t3')", '..' ],
+[ "Cygwin->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ],
+[ "Cygwin->abs2rel('/t4/t5/t6','/t1/t2/t3')", '../../../t4/t5/t6' ],
+#[ "Cygwin->abs2rel('../t4','/t1/t2/t3')", '../t4' ],
+[ "Cygwin->abs2rel('/','/t1/t2/t3')", '../../..' ],
+[ "Cygwin->abs2rel('///','/t1/t2/t3')", '../../..' ],
+[ "Cygwin->abs2rel('/.','/t1/t2/t3')", '../../..' ],
+[ "Cygwin->abs2rel('/./','/t1/t2/t3')", '../../..' ],
+#[ "Cygwin->abs2rel('../t4','/t1/t2/t3')", '../t4' ],
+[ "Cygwin->abs2rel('/t1/t2/t3', '/')", 't1/t2/t3' ],
+[ "Cygwin->abs2rel('/t1/t2/t3', '/t1')", 't2/t3' ],
+[ "Cygwin->abs2rel('t1/t2/t3', 't1')", 't2/t3' ],
+[ "Cygwin->abs2rel('t1/t2/t3', 't4')", '../t1/t2/t3' ],
+
+[ "Cygwin->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ],
+[ "Cygwin->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ],
+[ "Cygwin->rel2abs('.','/t1/t2/t3')", '/t1/t2/t3' ],
+[ "Cygwin->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ],
+[ "Cygwin->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ],
+[ "Cygwin->rel2abs('/t1','/t1/t2/t3')", '/t1' ],
+[ "Cygwin->rel2abs('//t1/t2/t3','/foo')", '//t1/t2/t3' ],
+
+) ;
+
+can_ok('File::Spec::Win32', '_cwd');
+
+{
+ package File::Spec::FakeWin32;
+ use vars qw(@ISA);
+ @ISA = qw(File::Spec::Win32);
+
+ sub _cwd { 'C:\\one\\two' }
+
+ # Some funky stuff to override Cwd::getdcwd() for testing purposes,
+ # in the limited scope of the rel2abs() method.
+ if ($Cwd::VERSION && $Cwd::VERSION gt '2.17') { # Avoid a 'used only once' warning
+ local $^W;
+ *rel2abs = sub {
+ my $self = shift;
+ local $^W;
+ local *Cwd::getdcwd = sub {
+ return 'D:\alpha\beta' if $_[0] eq 'D:';
+ return 'C:\one\two' if $_[0] eq 'C:';
+ return;
+ };
+ *Cwd::getdcwd = *Cwd::getdcwd; # Avoid a 'used only once' warning
+ return $self->SUPER::rel2abs(@_);
+ };
+ *rel2abs = *rel2abs; # Avoid a 'used only once' warning
+ }
+}
+
+# Tries a named function with the given args and compares the result against
+# an expected result. Works with functions that return scalars or arrays.
+for ( @tests ) {
+ my ($function, $expected) = @$_;
+
+ $function =~ s#\\#\\\\#g ;
+ $function =~ s/^([^\$].*->)/File::Spec::$1/;
+ my $got = join ',', eval $function;
+
+ SKIP: {
+ if ($@) {
+ skip "skip $function: $skip_exception", 1
+ if $@ =~ /^\Q$skip_exception/;
+ is($@, '', $function);
+ } else {
+ is($got, $expected, $function);
+ }
+ }
+}
+
+is +File::Spec::Unix->canonpath(), undef;
+
+done_testing();
diff --git a/cpan/dist/PathTools/t/abs2rel.t b/cpan/dist/PathTools/t/abs2rel.t
new file mode 100644
index 00000000..5e33ab6c
--- /dev/null
+++ b/cpan/dist/PathTools/t/abs2rel.t
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+use Cwd qw(cwd getcwd abs_path);
+use File::Spec();
+use File::Temp qw(tempdir);
+use File::Path qw(make_path);
+
+my $startdir = cwd();
+my @files = ( 'anyfile', './anyfile', '../first_sub_dir/anyfile', '../second_sub_dir/second_file' );
+
+for my $file (@files) {
+ test_rel2abs($file);
+}
+
+sub test_rel2abs {
+ my $first_file = shift;
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or die "Unable to change to $tdir: $!";
+
+ my @subdirs = (
+ 'first_sub_dir',
+ File::Spec->catdir('first_sub_dir', 'sub_sub_dir'),
+ 'second_sub_dir'
+ );
+ make_path(@subdirs, { mode => 0711 })
+ or die "Unable to make_path: $!";
+
+ open my $OUT2, '>',
+ File::Spec->catfile('second_sub_dir', 'second_file')
+ or die "Unable to open 'second_file' for writing: $!";
+ print $OUT2 "Attempting to resolve RT #121360\n";
+ close $OUT2 or die "Unable to close 'second_file' after writing: $!";
+
+ chdir 'first_sub_dir'
+ or die "Unable to change to 'first_sub_dir': $!";
+ open my $OUT1, '>', $first_file
+ or die "Unable to open $first_file for writing: $!";
+ print $OUT1 "Attempting to resolve RT #121360\n";
+ close $OUT1 or die "Unable to close $first_file after writing: $!";
+
+ my $rel_path = $first_file;
+ my $rel_base = File::Spec->catdir(File::Spec->curdir(), 'sub_sub_dir');
+ my $abs_path = File::Spec->rel2abs($rel_path);
+ my $abs_base = File::Spec->rel2abs($rel_base);
+ ok(-f $rel_path, "'$rel_path' is readable by effective uid/gid");
+ ok(-f $abs_path, "'$abs_path' is readable by effective uid/gid");
+ is_deeply(
+ [ (stat $rel_path)[0..5] ],
+ [ (stat $abs_path)[0..5] ],
+ "rel_path and abs_path stat same"
+ );
+ ok(-d $rel_base, "'$rel_base' is a directory");
+ ok(-d $abs_base, "'$abs_base' is a directory");
+ is_deeply(
+ [ (stat $rel_base)[0..5] ],
+ [ (stat $abs_base)[0..5] ],
+ "rel_base and abs_base stat same"
+ );
+ my $rr_link = File::Spec->abs2rel($rel_path, $rel_base);
+ my $ra_link = File::Spec->abs2rel($rel_path, $abs_base);
+ my $ar_link = File::Spec->abs2rel($abs_path, $rel_base);
+ my $aa_link = File::Spec->abs2rel($abs_path, $abs_base);
+ is($rr_link, $ra_link,
+ "rel_path-rel_base '$rr_link' = rel_path-abs_base '$ra_link'");
+ is($ar_link, $aa_link,
+ "abs_path-rel_base '$ar_link' = abs_path-abs_base '$aa_link'");
+ is($rr_link, $aa_link,
+ "rel_path-rel_base '$rr_link' = abs_path-abs_base '$aa_link'");
+
+ chdir $startdir or die "Unable to change back to $startdir: $!";
+}
+
+done_testing();
diff --git a/cpan/dist/PathTools/t/crossplatform.t b/cpan/dist/PathTools/t/crossplatform.t
new file mode 100644
index 00000000..b7c76fc1
--- /dev/null
+++ b/cpan/dist/PathTools/t/crossplatform.t
@@ -0,0 +1,173 @@
+#!/usr/bin/perl -w
+
+use strict;
+use File::Spec;
+use lib File::Spec->catfile('t', 'lib');
+use Test::More;
+local $|=1;
+
+my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32);
+my $tests_per_platform = 10;
+
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $vms_unix_mode = 0;
+my $vms_real_root = 0;
+
+if ($^O eq 'VMS') {
+ $vms_unix_mode = 0;
+ if (eval 'require VMS::Feature') {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ $vms_efs = VMS::Feature::current("efs_charset");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ }
+
+ # Traditional VMS mode only if VMS is not in UNIX compatible mode.
+ $vms_unix_mode = ($vms_efs && $vms_unix_rpt);
+
+ # If we are in UNIX mode, we may or may not have a real root.
+ if ($vms_unix_mode) {
+ my $rootdir = File::Spec->rootdir;
+ $vms_real_root = 1 if ($rootdir eq '/');
+ }
+
+}
+
+
+plan tests => 1 + @platforms * $tests_per_platform;
+
+my %volumes = (
+ Mac => 'Macintosh HD',
+ OS2 => 'A:',
+ Win32 => 'A:',
+ VMS => 'v',
+ );
+my %other_vols = (
+ Mac => 'Mounted Volume',
+ OS2 => 'B:',
+ Win32 => 'B:',
+ VMS => 'w',
+ );
+
+ok 1, "Loaded";
+
+foreach my $platform (@platforms) {
+ my $module = "File::Spec::$platform";
+
+ SKIP:
+ {
+ eval "require $module; 1";
+
+ skip "Can't load $module", $tests_per_platform
+ if $@;
+
+ my $v = $volumes{$platform} || '';
+ my $other_v = $other_vols{$platform} || '';
+
+ # Fake out the environment on MacOS and Win32
+ no strict 'refs';
+ my $save_w = $^W;
+ $^W = 0;
+ local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" };
+ local *{"File::Spec::Win32::_cwd"} = sub { "C:\\foo" };
+ $^W = $save_w;
+ use strict 'refs';
+
+
+ my ($file, $base, $result);
+
+ $base = $module->catpath($v, $module->catdir('', 'foo'), '');
+ $base = $module->catdir($module->rootdir, 'foo');
+
+ is $module->file_name_is_absolute($base), 1, "$base is absolute on $platform";
+
+ # splitdir('') -> ()
+ my @result = $module->splitdir('');
+ is @result, 0, "$platform->splitdir('') -> ()";
+
+ # canonpath() -> undef
+ $result = $module->canonpath();
+ is $result, undef, "$platform->canonpath() -> undef";
+
+ # canonpath(undef) -> undef
+ $result = $module->canonpath(undef);
+ is $result, undef, "$platform->canonpath(undef) -> undef";
+
+ # abs2rel('A:/foo/bar', 'A:/foo') -> 'bar'
+ $file = $module->catpath($v, $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
+ $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
+ $result = $module->catfile('bar', 'file');
+
+ if ($vms_unix_mode and $platform eq 'VMS') {
+ # test 56 special
+ # If VMS is in UNIX mode, so is the result, but having the volume
+ # parameter present forces the abs2rel into VMS mode.
+ $result = VMS::Filespec::vmsify($result);
+ $result =~ s/\.$//;
+
+ # If we have a real root, then we are dealing with absolute directories
+ $result =~ s/\[\./\[/ if $vms_real_root;
+ }
+
+ is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+
+ # abs2rel('A:/foo/bar', 'B:/foo') -> 'A:/foo/bar'
+ $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), '');
+ $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
+ is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+
+ # abs2rel('A:/foo/bar', '/foo') -> 'A:/foo/bar'
+ $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), '');
+ $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
+ is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+
+ # abs2rel('/foo/bar/file', 'A:/foo') -> '/foo/bar'
+ $file = $module->catpath('', $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
+ $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
+ $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file');
+
+ if ($vms_unix_mode and $platform eq 'VMS') {
+ # test 59 special
+ # If VMS is in UNIX mode, so is the result, but having the volume
+ # parameter present forces the abs2rel into VMS mode.
+ $result = VMS::Filespec::vmsify($result);
+ }
+
+ is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+
+ # abs2rel('/foo/bar', 'B:/foo') -> '/foo/bar'
+ $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), '');
+ $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file');
+
+ if ($vms_unix_mode and $platform eq 'VMS') {
+ # test 60 special
+ # If VMS is in UNIX mode, so is the result, but having the volume
+ # parameter present forces the abs2rel into VMS mode.
+ $result = VMS::Filespec::vmsify($result);
+ }
+
+ is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+
+ # abs2rel('/foo/bar', '/foo') -> 'bar'
+ $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), '');
+ $result = $module->catfile('bar', 'file');
+
+ is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+ }
+}
+
+sub volumes_differ {
+ my ($module, $one, $two) = @_;
+ my ($one_v) = $module->splitpath( $module->rel2abs($one) );
+ my ($two_v) = $module->splitpath( $module->rel2abs($two) );
+ return $one_v ne $two_v;
+}
diff --git a/cpan/dist/PathTools/t/cwd.t b/cpan/dist/PathTools/t/cwd.t
new file mode 100644
index 00000000..57fd866f
--- /dev/null
+++ b/cpan/dist/PathTools/t/cwd.t
@@ -0,0 +1,284 @@
+#!./perl -w
+
+use strict;
+
+use Cwd;
+
+chdir 't';
+@INC = '../../../lib' if $ENV{PERL_CORE};
+
+use Config;
+use File::Spec;
+use File::Path;
+
+use lib File::Spec->catdir('t', 'lib');
+use Test::More;
+
+my $IsVMS = $^O eq 'VMS';
+
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $vms_mode = 0;
+
+if ($IsVMS) {
+ require VMS::Filespec;
+ use Carp;
+ use Carp::Heavy;
+ $vms_mode = 1;
+ if (eval 'require VMS::Feature') {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ $vms_efs = VMS::Feature::current("efs_charset");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ }
+ $vms_mode = 0 if ($vms_unix_rpt);
+}
+
+my $tests = 31;
+# _perl_abs_path() currently only works when the directory separator
+# is '/', so don't test it when it won't work.
+my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin';
+$tests += 4 if $EXTRA_ABSPATH_TESTS;
+plan tests => $tests;
+
+SKIP: {
+ skip "no need to check for blib/ in the core", 1 if $ENV{PERL_CORE};
+ like $INC{'Cwd.pm'}, qr{blib}i, "Cwd should be loaded from blib/ during testing";
+}
+
+
+# check imports
+can_ok('main', qw(cwd getcwd fastcwd fastgetcwd));
+ok( !defined(&chdir), 'chdir() not exported by default' );
+ok( !defined(&abs_path), ' nor abs_path()' );
+ok( !defined(&fast_abs_path), ' nor fast_abs_path()');
+
+{
+ my @fields = qw(PATH IFS CDPATH ENV BASH_ENV);
+ my $before = grep exists $ENV{$_}, @fields;
+ cwd();
+ my $after = grep exists $ENV{$_}, @fields;
+ is($before, $after, "cwd() shouldn't create spurious entries in %ENV");
+}
+
+# XXX force Cwd to bootstrap its XSUBs since we have set @INC = "../lib"
+# XXX and subsequent chdir()s can make them impossible to find
+eval { fastcwd };
+
+# Must find an external pwd (or equivalent) command.
+
+my $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd";
+my $pwd_cmd =
+ ($^O eq "NetWare") ?
+ "cd" :
+ (grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" }
+ split m/$Config{path_sep}/, $ENV{PATH})[0];
+
+$pwd_cmd = 'SHOW DEFAULT' if $IsVMS;
+if ($^O eq 'MSWin32') {
+ $pwd_cmd =~ s,/,\\,g;
+ $pwd_cmd = "$pwd_cmd /c cd";
+}
+$pwd_cmd =~ s=\\=/=g if ($^O eq 'dos');
+
+SKIP: {
+ skip "No native pwd command found to test against", 4 unless $pwd_cmd;
+
+ print "# native pwd = '$pwd_cmd'\n";
+
+ local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
+ my ($pwd_cmd_untainted) = $pwd_cmd =~ /^(.+)$/; # Untaint.
+ chomp(my $start = `$pwd_cmd_untainted`);
+
+ # Win32's cd returns native C:\ style
+ $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
+ if ($IsVMS) {
+ # DCL SHOW DEFAULT has leading spaces
+ $start =~ s/^\s+//;
+
+ # When in UNIX report mode, need to convert to compare it.
+ if ($vms_unix_rpt) {
+ $start = VMS::Filespec::unixpath($start);
+ # Remove trailing slash.
+ $start =~ s#/$##;
+ }
+ }
+ SKIP: {
+ skip("'$pwd_cmd' failed, nothing to test against", 4) if $?;
+ skip("/afs seen, paths unlikely to match", 4) if $start =~ m|/afs/|;
+
+ # Darwin's getcwd(3) (which Cwd.xs:bsd_realpath() uses which
+ # Cwd.pm:getcwd uses) has some magic related to the PWD
+ # environment variable: if PWD is set to a directory that
+ # looks about right (guess: has the same (dev,ino) as the '.'?),
+ # the PWD is returned. However, if that path contains
+ # symlinks, the path will not be equal to the one returned by
+ # /bin/pwd (which probably uses the usual walking upwards in
+ # the path -trick). This situation is easy to reproduce since
+ # /tmp is a symlink to /private/tmp. Therefore we invalidate
+ # the PWD to force getcwd(3) to (re)compute the cwd in full.
+ # Admittedly fixing this in the Cwd module would be better
+ # long-term solution but deleting $ENV{PWD} should not be
+ # done light-heartedly. --jhi
+ delete $ENV{PWD} if $^O eq 'darwin';
+
+ my $cwd = cwd;
+ my $getcwd = getcwd;
+ my $fastcwd = fastcwd;
+ my $fastgetcwd = fastgetcwd;
+
+ is($cwd, $start, 'cwd()');
+ is($getcwd, $start, 'getcwd()');
+ is($fastcwd, $start, 'fastcwd()');
+ is($fastgetcwd, $start, 'fastgetcwd()');
+ }
+}
+
+my @test_dirs = qw{_ptrslt_ _path_ _to_ _a_ _dir_};
+my $Test_Dir = File::Spec->catdir(@test_dirs);
+
+mkpath([$Test_Dir], 0, 0777);
+Cwd::chdir $Test_Dir;
+
+foreach my $func (qw(cwd getcwd fastcwd fastgetcwd)) {
+ my $result = eval "$func()";
+ is $@, '';
+ dir_ends_with( $result, $Test_Dir, "$func()" );
+}
+
+{
+ # Some versions of File::Path (e.g. that shipped with perl 5.8.5)
+ # call getcwd() with an argument (perhaps by calling it as a
+ # method?), so make sure that doesn't die.
+ is getcwd(), getcwd('foo'), "Call getcwd() with an argument";
+}
+
+# Cwd::chdir should also update $ENV{PWD}
+dir_ends_with( $ENV{PWD}, $Test_Dir, 'Cwd::chdir() updates $ENV{PWD}' );
+my $updir = File::Spec->updir;
+
+for (1..@test_dirs) {
+ Cwd::chdir $updir;
+ print "#$ENV{PWD}\n";
+}
+
+rmtree($test_dirs[0], 0, 0);
+
+{
+ my $check = ($vms_mode ? qr|\b((?i)t)\]$| :
+ qr|\bt$| );
+
+ like($ENV{PWD}, $check);
+}
+
+{
+ # Make sure abs_path() doesn't trample $ENV{PWD}
+ my $start_pwd = $ENV{PWD};
+ mkpath([$Test_Dir], 0, 0777);
+ Cwd::abs_path($Test_Dir);
+ is $ENV{PWD}, $start_pwd;
+ rmtree($test_dirs[0], 0, 0);
+}
+
+SKIP: {
+ skip "no symlinks on this platform", 2+$EXTRA_ABSPATH_TESTS unless $Config{d_symlink} && $^O !~ m!^(qnx|nto)!;
+
+ my $file = "linktest";
+ mkpath([$Test_Dir], 0, 0777);
+ symlink $Test_Dir, $file;
+
+ my $abs_path = Cwd::abs_path($file);
+ my $fast_abs_path = Cwd::fast_abs_path($file);
+ my $want = quotemeta(
+ File::Spec->rel2abs( $Test_Dir )
+ );
+ if ($^O eq 'VMS') {
+ # Not easy to predict the physical volume name
+ $want = $ENV{PERL_CORE} ? $Test_Dir : File::Spec->catdir('t', $Test_Dir);
+
+ # So just use the relative volume name
+ $want =~ s/^\[//;
+
+ $want = quotemeta($want);
+ }
+
+ like($abs_path, qr|$want$|i);
+ like($fast_abs_path, qr|$want$|i);
+ like(Cwd::_perl_abs_path($file), qr|$want$|i) if $EXTRA_ABSPATH_TESTS;
+
+ rmtree($test_dirs[0], 0, 0);
+ 1 while unlink $file;
+}
+
+# Make sure we can run abs_path() on files, not just directories
+my $path = 'cwd.t';
+path_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file');
+path_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file');
+path_ends_with(Cwd::_perl_abs_path($path), 'cwd.t', '_perl_abs_path() can be invoked on a file')
+ if $EXTRA_ABSPATH_TESTS;
+
+$path = File::Spec->catfile(File::Spec->updir, 't', $path);
+path_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file');
+path_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file');
+path_ends_with(Cwd::_perl_abs_path($path), 'cwd.t', '_perl_abs_path() can be invoked on a file')
+ if $EXTRA_ABSPATH_TESTS;
+
+
+
+SKIP: {
+ my $file;
+ {
+ my $root = Cwd::abs_path(File::Spec->rootdir); # Add drive letter?
+ local *FH;
+ opendir FH, $root or skip("Can't opendir($root): $!", 2+$EXTRA_ABSPATH_TESTS);
+ ($file) = grep {-f $_ and not -l $_} map File::Spec->catfile($root, $_), readdir FH;
+ closedir FH;
+ }
+ skip "No plain file in root directory to test with", 2+$EXTRA_ABSPATH_TESTS unless $file;
+
+ $file = VMS::Filespec::rmsexpand($file) if $^O eq 'VMS';
+ is Cwd::abs_path($file), $file, 'abs_path() works on files in the root directory';
+ is Cwd::fast_abs_path($file), $file, 'fast_abs_path() works on files in the root directory';
+ is Cwd::_perl_abs_path($file), $file, '_perl_abs_path() works on files in the root directory'
+ if $EXTRA_ABSPATH_TESTS;
+}
+
+SKIP: {
+ my $dir = "${$}a\nx";
+ mkdir $dir or skip "OS does not support dir names containing LF";
+ chdir $dir or skip "OS cannot chdir into LF";
+ eval { Cwd::fast_abs_path() };
+ is $@, "", 'fast_abs_path does not die in dir whose name contains LF';
+ chdir File::Spec->updir;
+ rmdir $dir;
+}
+
+
+#############################################
+# These routines give us sort of a poor-man's cross-platform
+# directory or path comparison capability.
+
+sub bracketed_form_dir {
+ return join '', map "[$_]",
+ grep length, File::Spec->splitdir(File::Spec->canonpath( shift() ));
+}
+
+sub dir_ends_with {
+ my ($dir, $expect) = (shift, shift);
+ my $bracketed_expect = quotemeta bracketed_form_dir($expect);
+ like( bracketed_form_dir($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) );
+}
+
+sub bracketed_form_path {
+ return join '', map "[$_]",
+ grep length, File::Spec->splitpath(File::Spec->canonpath( shift() ));
+}
+
+sub path_ends_with {
+ my ($dir, $expect) = (shift, shift);
+ my $bracketed_expect = quotemeta bracketed_form_path($expect);
+ like( bracketed_form_path($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) );
+}
diff --git a/cpan/dist/PathTools/t/lib/Test/Builder.pm b/cpan/dist/PathTools/t/lib/Test/Builder.pm
new file mode 100644
index 00000000..541a8512
--- /dev/null
+++ b/cpan/dist/PathTools/t/lib/Test/Builder.pm
@@ -0,0 +1,1499 @@
+package Test::Builder;
+
+use 5.004;
+
+# $^C was only introduced in 5.005-ish. We do this to prevent
+# use of uninitialized value warnings in older perls.
+$^C ||= 0;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.19';
+
+my $IsVMS = $^O eq 'VMS';
+
+# Make Test::Builder thread-safe for ithreads.
+BEGIN {
+ use Config;
+ # Load threads::shared when threads are turned on
+ if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
+ require threads::shared;
+ threads::shared->import;
+ }
+ # 5.8.0's threads::shared is busted when threads are off.
+ # We emulate it here.
+ else {
+ *share = sub { return $_[0] };
+ *lock = sub { 0 };
+ }
+}
+
+
+=head1 NAME
+
+Test::Builder - Backend for building test libraries
+
+=head1 SYNOPSIS
+
+ package My::Test::Module;
+ use Test::Builder;
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(ok);
+
+ my $Test = Test::Builder->new;
+ $Test->output('my_logfile');
+
+ sub import {
+ my($self) = shift;
+ my $pack = caller;
+
+ $Test->exported_to($pack);
+ $Test->plan(@_);
+
+ $self->export_to_level(1, $self, 'ok');
+ }
+
+ sub ok {
+ my($test, $name) = @_;
+
+ $Test->ok($test, $name);
+ }
+
+
+=head1 DESCRIPTION
+
+Test::Simple and Test::More have proven to be popular testing modules,
+but they're not always flexible enough. Test::Builder provides the a
+building block upon which to write your own test libraries I<which can
+work together>.
+
+=head2 Construction
+
+=over 4
+
+=item B<new>
+
+ my $Test = Test::Builder->new;
+
+Returns a Test::Builder object representing the current state of the
+test.
+
+Since you only run one test per program, there is B<one and only one>
+Test::Builder object. No matter how many times you call new(), you're
+getting the same object. (This is called a singleton).
+
+=cut
+
+my $Test = Test::Builder->new;
+sub new {
+ my($class) = shift;
+ $Test ||= bless ['Move along, nothing to see here'], $class;
+ return $Test;
+}
+
+=item B<reset>
+
+ $Test->reset;
+
+Reinitializes the Test::Builder singleton to its original state.
+Mostly useful for tests run in persistent environments where the same
+test might be run multiple times in the same process.
+
+=cut
+
+my $Test_Died;
+my $Have_Plan;
+my $No_Plan;
+my $Curr_Test; share($Curr_Test);
+use vars qw($Level);
+my $Original_Pid;
+my @Test_Results; share(@Test_Results);
+my @Test_Details; share(@Test_Details);
+
+my $Exported_To;
+my $Expected_Tests;
+
+my $Skip_All;
+
+my $Use_Nums;
+
+my($No_Header, $No_Ending);
+
+$Test->reset;
+
+sub reset {
+ my ($self) = @_;
+
+ $Test_Died = 0;
+ $Have_Plan = 0;
+ $No_Plan = 0;
+ $Curr_Test = 0;
+ $Level = 1;
+ $Original_Pid = $$;
+ @Test_Results = ();
+ @Test_Details = ();
+
+ $Exported_To = undef;
+ $Expected_Tests = 0;
+
+ $Skip_All = 0;
+
+ $Use_Nums = 1;
+
+ ($No_Header, $No_Ending) = (0,0);
+
+ $self->_dup_stdhandles unless $^C;
+
+ return undef;
+}
+
+=back
+
+=head2 Setting up tests
+
+These methods are for setting up tests and declaring how many there
+are. You usually only want to call one of these methods.
+
+=over 4
+
+=item B<exported_to>
+
+ my $pack = $Test->exported_to;
+ $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+This is important for getting TODO tests right.
+
+=cut
+
+sub exported_to {
+ my($self, $pack) = @_;
+
+ if( defined $pack ) {
+ $Exported_To = $pack;
+ }
+ return $Exported_To;
+}
+
+=item B<plan>
+
+ $Test->plan('no_plan');
+ $Test->plan( skip_all => $reason );
+ $Test->plan( tests => $num_tests );
+
+A convenient way to set up your tests. Call this and Test::Builder
+will print the appropriate headers and take the appropriate actions.
+
+If you call plan(), don't call any of the other methods below.
+
+=cut
+
+sub plan {
+ my($self, $cmd, $arg) = @_;
+
+ return unless $cmd;
+
+ if( $Have_Plan ) {
+ die sprintf "You tried to plan twice! Second plan at %s line %d\n",
+ ($self->caller)[1,2];
+ }
+
+ if( $cmd eq 'no_plan' ) {
+ $self->no_plan;
+ }
+ elsif( $cmd eq 'skip_all' ) {
+ return $self->skip_all($arg);
+ }
+ elsif( $cmd eq 'tests' ) {
+ if( $arg ) {
+ return $self->expected_tests($arg);
+ }
+ elsif( !defined $arg ) {
+ die "Got an undefined number of tests. Looks like you tried to ".
+ "say how many tests you plan to run but made a mistake.\n";
+ }
+ elsif( !$arg ) {
+ die "You said to run 0 tests! You've got to run something.\n";
+ }
+ }
+ else {
+ require Carp;
+ my @args = grep { defined } ($cmd, $arg);
+ Carp::croak("plan() doesn't understand @args");
+ }
+
+ return 1;
+}
+
+=item B<expected_tests>
+
+ my $max = $Test->expected_tests;
+ $Test->expected_tests($max);
+
+Gets/sets the # of tests we expect this test to run and prints out
+the appropriate headers.
+
+=cut
+
+sub expected_tests {
+ my($self, $max) = @_;
+
+ if( defined $max ) {
+ $Expected_Tests = $max;
+ $Have_Plan = 1;
+
+ $self->_print("1..$max\n") unless $self->no_header;
+ }
+ return $Expected_Tests;
+}
+
+
+=item B<no_plan>
+
+ $Test->no_plan;
+
+Declares that this test will run an indeterminate # of tests.
+
+=cut
+
+sub no_plan {
+ $No_Plan = 1;
+ $Have_Plan = 1;
+}
+
+=item B<has_plan>
+
+ $plan = $Test->has_plan
+
+Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
+
+=cut
+
+sub has_plan {
+ return($Expected_Tests) if $Expected_Tests;
+ return('no_plan') if $No_Plan;
+ return(undef);
+};
+
+
+=item B<skip_all>
+
+ $Test->skip_all;
+ $Test->skip_all($reason);
+
+Skips all the tests, using the given $reason. Exits immediately with 0.
+
+=cut
+
+sub skip_all {
+ my($self, $reason) = @_;
+
+ my $out = "1..0";
+ $out .= " # Skip $reason" if $reason;
+ $out .= "\n";
+
+ $Skip_All = 1;
+
+ $self->_print($out) unless $self->no_header;
+ exit(0);
+}
+
+=back
+
+=head2 Running tests
+
+These actually run the tests, analogous to the functions in
+Test::More.
+
+$name is always optional.
+
+=over 4
+
+=item B<ok>
+
+ $Test->ok($test, $name);
+
+Your basic test. Pass if $test is true, fail if $test is false. Just
+like Test::Simple's ok().
+
+=cut
+
+sub ok {
+ my($self, $test, $name) = @_;
+
+ # $test might contain an object which we don't want to accidentally
+ # store, so we turn it into a boolean.
+ $test = $test ? 1 : 0;
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
+ }
+
+ lock $Curr_Test;
+ $Curr_Test++;
+
+ # In case $name is a string overloaded object, force it to stringify.
+ local($@,$!);
+ eval {
+ if( defined $name ) {
+ require overload;
+ if( my $string_meth = overload::Method($name, '""') ) {
+ $name = $name->$string_meth();
+ }
+ }
+ };
+
+ $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
+ You named your test '$name'. You shouldn't use numbers for your test names.
+ Very confusing.
+ERR
+
+ my($pack, $file, $line) = $self->caller;
+
+ my $todo = $self->todo($pack);
+
+ my $out;
+ my $result = &share({});
+
+ unless( $test ) {
+ $out .= "not ";
+ @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
+ }
+ else {
+ @$result{ 'ok', 'actual_ok' } = ( 1, $test );
+ }
+
+ $out .= "ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+
+ if( defined $name ) {
+ $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
+ $out .= " - $name";
+ $result->{name} = $name;
+ }
+ else {
+ $result->{name} = '';
+ }
+
+ if( $todo ) {
+ my $what_todo = $todo;
+ $out .= " # TODO $what_todo";
+ $result->{reason} = $what_todo;
+ $result->{type} = 'todo';
+ }
+ else {
+ $result->{reason} = '';
+ $result->{type} = '';
+ }
+
+ $Test_Results[$Curr_Test-1] = $result;
+ $out .= "\n";
+
+ $self->_print($out);
+
+ unless( $test ) {
+ my $msg = $todo ? "Failed (TODO)" : "Failed";
+ $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
+ $self->diag(" $msg test ($file at line $line)\n");
+ }
+
+ return $test ? 1 : 0;
+}
+
+=item B<is_eq>
+
+ $Test->is_eq($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got eq $expected. This is the
+string version.
+
+=item B<is_num>
+
+ $Test->is_num($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got == $expected. This is the
+numeric version.
+
+=cut
+
+sub is_eq {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, 'eq', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'eq', $expect, $name);
+}
+
+sub is_num {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, '==', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '==', $expect, $name);
+}
+
+sub _is_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ foreach my $val (\$got, \$expect) {
+ if( defined $$val ) {
+ if( $type eq 'eq' ) {
+ # quote and force string context
+ $$val = "'$$val'"
+ }
+ else {
+ # force numeric context
+ $$val = $$val+0;
+ }
+ }
+ else {
+ $$val = 'undef';
+ }
+ }
+
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+ got: %s
+ expected: %s
+DIAGNOSTIC
+
+}
+
+=item B<isnt_eq>
+
+ $Test->isnt_eq($got, $dont_expect, $name);
+
+Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+the string version.
+
+=item B<isnt_num>
+
+ $Test->is_num($got, $dont_expect, $name);
+
+Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+the numeric version.
+
+=cut
+
+sub isnt_eq {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'ne', $dont_expect, $name);
+}
+
+sub isnt_num {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag($got, '!=', $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '!=', $dont_expect, $name);
+}
+
+
+=item B<like>
+
+ $Test->like($this, qr/$regex/, $name);
+ $Test->like($this, '/$regex/', $name);
+
+Like Test::More's like(). Checks if $this matches the given $regex.
+
+You'll want to avoid qr// if you want your tests to work before 5.005.
+
+=item B<unlike>
+
+ $Test->unlike($this, qr/$regex/, $name);
+ $Test->unlike($this, '/$regex/', $name);
+
+Like Test::More's unlike(). Checks if $this B<does not match> the
+given $regex.
+
+=cut
+
+sub like {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '=~', $name);
+}
+
+sub unlike {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '!~', $name);
+}
+
+=item B<maybe_regex>
+
+ $Test->maybe_regex(qr/$regex/);
+ $Test->maybe_regex('/$regex/');
+
+Convenience method for building testing functions that take regular
+expressions as arguments, but need to work before perl 5.005.
+
+Takes a quoted regular expression produced by qr//, or a string
+representing a regular expression.
+
+Returns a Perl value which may be used instead of the corresponding
+regular expression, or undef if it's argument is not recognised.
+
+For example, a version of like(), sans the useful diagnostic messages,
+could be written as:
+
+ sub laconic_like {
+ my ($self, $this, $regex, $name) = @_;
+ my $usable_regex = $self->maybe_regex($regex);
+ die "expecting regex, found '$regex'\n"
+ unless $usable_regex;
+ $self->ok($this =~ m/$usable_regex/, $name);
+ }
+
+=cut
+
+
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ my $usable_regex = undef;
+ if( ref $regex eq 'Regexp' ) {
+ $usable_regex = $regex;
+ }
+ # Check if it looks like '/foo/'
+ elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
+ $usable_regex = length $opts ? "(?$opts)$re" : $re;
+ };
+ return($usable_regex)
+};
+
+sub _regex_ok {
+ my($self, $this, $regex, $cmp, $name) = @_;
+
+ local $Level = $Level + 1;
+
+ my $ok = 0;
+ my $usable_regex = $self->maybe_regex($regex);
+ unless (defined $usable_regex) {
+ $ok = $self->ok( 0, $name );
+ $self->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ {
+ local $^W = 0;
+ my $test = $this =~ /$usable_regex/ ? 1 : 0;
+ $test = !$test if $cmp eq '!~';
+ $ok = $self->ok( $test, $name );
+ }
+
+ unless( $ok ) {
+ $this = defined $this ? "'$this'" : 'undef';
+ my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+ $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
+ %s
+ %13s '%s'
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<cmp_ok>
+
+ $Test->cmp_ok($this, $type, $that, $name);
+
+Works just like Test::More's cmp_ok().
+
+ $Test->cmp_ok($big_num, '!=', $other_big_num);
+
+=cut
+
+sub cmp_ok {
+ my($self, $got, $type, $expect, $name) = @_;
+
+ my $test;
+ {
+ local $^W = 0;
+ local($@,$!); # don't interfere with $@
+ # eval() sometimes resets $!
+ $test = eval "\$got $type \$expect";
+ }
+ local $Level = $Level + 1;
+ my $ok = $self->ok($test, $name);
+
+ unless( $ok ) {
+ if( $type =~ /^(eq|==)$/ ) {
+ $self->_is_diag($got, $type, $expect);
+ }
+ else {
+ $self->_cmp_diag($got, $type, $expect);
+ }
+ }
+ return $ok;
+}
+
+sub _cmp_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ $got = defined $got ? "'$got'" : 'undef';
+ $expect = defined $expect ? "'$expect'" : 'undef';
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
+ %s
+ %s
+ %s
+DIAGNOSTIC
+}
+
+=item B<BAILOUT>
+
+ $Test->BAILOUT($reason);
+
+Indicates to the Test::Harness that things are going so badly all
+testing should terminate. This includes running any additional test
+scripts.
+
+It will exit with 255.
+
+=cut
+
+sub BAILOUT {
+ my($self, $reason) = @_;
+
+ $self->_print("Bail out! $reason");
+ exit 255;
+}
+
+=item B<skip>
+
+ $Test->skip;
+ $Test->skip($why);
+
+Skips the current test, reporting $why.
+
+=cut
+
+sub skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($Curr_Test);
+ $Curr_Test++;
+
+ $Test_Results[$Curr_Test-1] = &share({
+ 'ok' => 1,
+ actual_ok => 1,
+ name => '',
+ type => 'skip',
+ reason => $why,
+ });
+
+ my $out = "ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+ $out .= " # skip $why\n";
+
+ $Test->_print($out);
+
+ return 1;
+}
+
+
+=item B<todo_skip>
+
+ $Test->todo_skip;
+ $Test->todo_skip($why);
+
+Like skip(), only it will declare the test as failing and TODO. Similar
+to
+
+ print "not ok $tnum # TODO $why\n";
+
+=cut
+
+sub todo_skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($Curr_Test);
+ $Curr_Test++;
+
+ $Test_Results[$Curr_Test-1] = &share({
+ 'ok' => 1,
+ actual_ok => 0,
+ name => '',
+ type => 'todo_skip',
+ reason => $why,
+ });
+
+ my $out = "not ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+ $out .= " # TODO & SKIP $why\n";
+
+ $Test->_print($out);
+
+ return 1;
+}
+
+
+=begin _unimplemented
+
+=item B<skip_rest>
+
+ $Test->skip_rest;
+ $Test->skip_rest($reason);
+
+Like skip(), only it skips all the rest of the tests you plan to run
+and terminates the test.
+
+If you're running under no_plan, it skips once and terminates the
+test.
+
+=end _unimplemented
+
+=back
+
+
+=head2 Test style
+
+=over 4
+
+=item B<level>
+
+ $Test->level($how_high);
+
+How far up the call stack should $Test look when reporting where the
+test failed.
+
+Defaults to 1.
+
+Setting $Test::Builder::Level overrides. This is typically useful
+localized:
+
+ {
+ local $Test::Builder::Level = 2;
+ $Test->ok($test);
+ }
+
+=cut
+
+sub level {
+ my($self, $level) = @_;
+
+ if( defined $level ) {
+ $Level = $level;
+ }
+ return $Level;
+}
+
+
+=item B<use_numbers>
+
+ $Test->use_numbers($on_or_off);
+
+Whether or not the test should output numbers. That is, this if true:
+
+ ok 1
+ ok 2
+ ok 3
+
+or this if false
+
+ ok
+ ok
+ ok
+
+Most useful when you can't depend on the test output order, such as
+when threads or forking is involved.
+
+Test::Harness will accept either, but avoid mixing the two styles.
+
+Defaults to on.
+
+=cut
+
+sub use_numbers {
+ my($self, $use_nums) = @_;
+
+ if( defined $use_nums ) {
+ $Use_Nums = $use_nums;
+ }
+ return $Use_Nums;
+}
+
+=item B<no_header>
+
+ $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
+=item B<no_ending>
+
+ $Test->no_ending($no_ending);
+
+Normally, Test::Builder does some extra diagnostics when the test
+ends. It also changes the exit code as described below.
+
+If this is true, none of that will be done.
+
+=cut
+
+sub no_header {
+ my($self, $no_header) = @_;
+
+ if( defined $no_header ) {
+ $No_Header = $no_header;
+ }
+ return $No_Header;
+}
+
+sub no_ending {
+ my($self, $no_ending) = @_;
+
+ if( defined $no_ending ) {
+ $No_Ending = $no_ending;
+ }
+ return $No_Ending;
+}
+
+
+=back
+
+=head2 Output
+
+Controlling where the test output goes.
+
+It's ok for your test to change where STDOUT and STDERR point to,
+Test::Builder's default output settings will not be affected.
+
+=over 4
+
+=item B<diag>
+
+ $Test->diag(@msgs);
+
+Prints out the given $message. Normally, it uses the failure_output()
+handle, but if this is for a TODO test, the todo_output() handle is
+used.
+
+Output will be indented and marked with a # so as not to interfere
+with test output. A newline will be put on the end if there isn't one
+already.
+
+We encourage using this rather than calling print directly.
+
+Returns false. Why? Because diag() is often used in conjunction with
+a failing test (C<ok() || diag()>) it "passes through" the failure.
+
+ return ok(...) || diag(...);
+
+=for blame transfer
+Mark Fowler <mark@twoshortplanks.com>
+
+=cut
+
+sub diag {
+ my($self, @msgs) = @_;
+ return unless @msgs;
+
+ # Prevent printing headers when compiling (i.e. -c)
+ return if $^C;
+
+ # Escape each line with a #.
+ foreach (@msgs) {
+ $_ = 'undef' unless defined;
+ s/^/# /gms;
+ }
+
+ push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
+ local $Level = $Level + 1;
+ $self->_print_diag(@msgs);
+
+ return 0;
+}
+
+=begin _private
+
+=item B<_print>
+
+ $Test->_print(@msgs);
+
+Prints to the output() filehandle.
+
+=end _private
+
+=cut
+
+sub _print {
+ my($self, @msgs) = @_;
+
+ # Prevent printing headers when only compiling. Mostly for when
+ # tests are deparsed with B::Deparse
+ return if $^C;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->output;
+
+ # Escape each line after the first with a # so we don't
+ # confuse Test::Harness.
+ foreach (@msgs) {
+ s/\n(.)/\n# $1/sg;
+ }
+
+ push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
+ print $fh @msgs;
+}
+
+
+=item B<_print_diag>
+
+ $Test->_print_diag(@msg);
+
+Like _print, but prints to the current diagnostic filehandle.
+
+=cut
+
+sub _print_diag {
+ my $self = shift;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+ print $fh @_;
+}
+
+=item B<output>
+
+ $Test->output($fh);
+ $Test->output($file);
+
+Where normal "ok/not ok" test output should go.
+
+Defaults to STDOUT.
+
+=item B<failure_output>
+
+ $Test->failure_output($fh);
+ $Test->failure_output($file);
+
+Where diagnostic output on test failures and diag() should go.
+
+Defaults to STDERR.
+
+=item B<todo_output>
+
+ $Test->todo_output($fh);
+ $Test->todo_output($file);
+
+Where diagnostics about todo test failures and diag() should go.
+
+Defaults to STDOUT.
+
+=cut
+
+my($Out_FH, $Fail_FH, $Todo_FH);
+sub output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Out_FH = _new_fh($fh);
+ }
+ return $Out_FH;
+}
+
+sub failure_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Fail_FH = _new_fh($fh);
+ }
+ return $Fail_FH;
+}
+
+sub todo_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Todo_FH = _new_fh($fh);
+ }
+ return $Todo_FH;
+}
+
+sub _new_fh {
+ my($file_or_fh) = shift;
+
+ my $fh;
+ unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
+ $fh = do { local *FH };
+ open $fh, ">$file_or_fh" or
+ die "Can't open test output log $file_or_fh: $!";
+ }
+ else {
+ $fh = $file_or_fh;
+ }
+
+ return $fh;
+}
+
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+
+my $Opened_Testhandles = 0;
+sub _dup_stdhandles {
+ my $self = shift;
+
+ $self->_open_testhandles unless $Opened_Testhandles;
+
+ # Set everything to unbuffered else plain prints to STDOUT will
+ # come out in the wrong order from our own prints.
+ _autoflush(\*TESTOUT);
+ _autoflush(\*STDOUT);
+ _autoflush(\*TESTERR);
+ _autoflush(\*STDERR);
+
+ $Test->output(\*TESTOUT);
+ $Test->failure_output(\*TESTERR);
+ $Test->todo_output(\*TESTOUT);
+}
+
+sub _open_testhandles {
+ # We dup STDOUT and STDERR so people can change them in their
+ # test suites while still getting normal test output.
+ open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
+ open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
+ $Opened_Testhandles = 1;
+}
+
+
+=back
+
+
+=head2 Test Status and Info
+
+=over 4
+
+=item B<current_test>
+
+ my $curr_test = $Test->current_test;
+ $Test->current_test($num);
+
+Gets/sets the current test # we're on.
+
+You usually shouldn't have to set this.
+
+=cut
+
+sub current_test {
+ my($self, $num) = @_;
+
+ lock($Curr_Test);
+ if( defined $num ) {
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("Can't change the current test number without a plan!");
+ }
+
+ $Curr_Test = $num;
+ if( $num > @Test_Results ) {
+ my $start = @Test_Results ? $#Test_Results + 1 : 0;
+ for ($start..$num-1) {
+ $Test_Results[$_] = &share({
+ 'ok' => 1,
+ actual_ok => undef,
+ reason => 'incrementing test number',
+ type => 'unknown',
+ name => undef
+ });
+ }
+ }
+ }
+ return $Curr_Test;
+}
+
+
+=item B<summary>
+
+ my @tests = $Test->summary;
+
+A simple summary of the tests so far. True for pass, false for fail.
+This is a logical pass/fail, so todos are passes.
+
+Of course, test #1 is $tests[0], etc...
+
+=cut
+
+sub summary {
+ my($self) = shift;
+
+ return map { $_->{'ok'} } @Test_Results;
+}
+
+=item B<details>
+
+ my @tests = $Test->details;
+
+Like summary(), but with a lot more detail.
+
+ $tests[$test_num - 1] =
+ { 'ok' => is the test considered a pass?
+ actual_ok => did it literally say 'ok'?
+ name => name of the test (if any)
+ type => type of test (if any, see below).
+ reason => reason for the above (if any)
+ };
+
+'ok' is true if Test::Harness will consider the test to be a pass.
+
+'actual_ok' is a reflection of whether or not the test literally
+printed 'ok' or 'not ok'. This is for examining the result of 'todo'
+tests.
+
+'name' is the name of the test.
+
+'type' indicates if it was a special test. Normal tests have a type
+of ''. Type can be one of the following:
+
+ skip see skip()
+ todo see todo()
+ todo_skip see todo_skip()
+ unknown see below
+
+Sometimes the Test::Builder test counter is incremented without it
+printing any test output, for example, when current_test() is changed.
+In these cases, Test::Builder doesn't know the result of the test, so
+it's type is 'unkown'. These details for these tests are filled in.
+They are considered ok, but the name and actual_ok is left undef.
+
+For example "not ok 23 - hole count # TODO insufficient donuts" would
+result in this structure:
+
+ $tests[22] = # 23 - 1, since arrays start from 0.
+ { ok => 1, # logically, the test passed since it's todo
+ actual_ok => 0, # in absolute terms, it failed
+ name => 'hole count',
+ type => 'todo',
+ reason => 'insufficient donuts'
+ };
+
+=cut
+
+sub details {
+ return @Test_Results;
+}
+
+=item B<todo>
+
+ my $todo_reason = $Test->todo;
+ my $todo_reason = $Test->todo($pack);
+
+todo() looks for a $TODO variable in your tests. If set, all tests
+will be considered 'todo' (see Test::More and Test::Harness for
+details). Returns the reason (ie. the value of $TODO) if running as
+todo tests, false otherwise.
+
+todo() is pretty part about finding the right package to look for
+$TODO in. It uses the exported_to() package to find it. If that's
+not set, it's pretty good at guessing the right package to look at.
+
+Sometimes there is some confusion about where todo() should be looking
+for the $TODO variable. If you want to be sure, tell it explicitly
+what $pack to use.
+
+=cut
+
+sub todo {
+ my($self, $pack) = @_;
+
+ $pack = $pack || $self->exported_to || $self->caller(1);
+
+ no strict 'refs';
+ return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
+ : 0;
+}
+
+=item B<caller>
+
+ my $package = $Test->caller;
+ my($pack, $file, $line) = $Test->caller;
+ my($pack, $file, $line) = $Test->caller($height);
+
+Like the normal caller(), except it reports according to your level().
+
+=cut
+
+sub caller {
+ my($self, $height) = @_;
+ $height ||= 0;
+
+ my @caller = CORE::caller($self->level + $height + 1);
+ return wantarray ? @caller : $caller[0];
+}
+
+=back
+
+=cut
+
+=begin _private
+
+=over 4
+
+=item B<_sanity_check>
+
+ _sanity_check();
+
+Runs a bunch of end of test sanity checks to make sure reality came
+through ok. If anything is wrong it will die with a fairly friendly
+error message.
+
+=cut
+
+#'#
+sub _sanity_check {
+ _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
+ _whoa(!$Have_Plan and $Curr_Test,
+ 'Somehow your tests ran without a plan!');
+ _whoa($Curr_Test != @Test_Results,
+ 'Somehow you got a different number of results than tests ran!');
+}
+
+=item B<_whoa>
+
+ _whoa($check, $description);
+
+A sanity check, similar to assert(). If the $check is true, something
+has gone horribly wrong. It will die with the given $description and
+a note to contact the author.
+
+=cut
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+=item B<_my_exit>
+
+ _my_exit($exit_num);
+
+Perl seems to have some trouble with exiting inside an END block. 5.005_03
+and 5.6.1 both seem to do odd things. Instead, this function edits $?
+directly. It should ONLY be called from inside an END block. It
+doesn't actually exit, that's your job.
+
+=cut
+
+sub _my_exit {
+ $? = $_[0];
+
+ return 1;
+}
+
+
+=back
+
+=end _private
+
+=cut
+
+$SIG{__DIE__} = sub {
+ # We don't want to muck with death in an eval, but $^S isn't
+ # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
+ # with it. Instead, we use caller. This also means it runs under
+ # 5.004!
+ my $in_eval = 0;
+ for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
+ $in_eval = 1 if $sub =~ /^\(eval\)/;
+ }
+ $Test_Died = 1 unless $in_eval;
+};
+
+sub _ending {
+ my $self = shift;
+
+ _sanity_check();
+
+ # Don't bother with an ending if this is a forked copy. Only the parent
+ # should do the ending.
+ do{ _my_exit($?) && return } if $Original_Pid != $$;
+
+ # Bailout if plan() was never called. This is so
+ # "require Test::Simple" doesn't puke.
+ do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
+
+ # Figure out if we passed or failed and print helpful messages.
+ if( @Test_Results ) {
+ # The plan? We have no plan.
+ if( $No_Plan ) {
+ $self->_print("1..$Curr_Test\n") unless $self->no_header;
+ $Expected_Tests = $Curr_Test;
+ }
+
+ # Auto-extended arrays and elements which aren't explicitly
+ # filled in with a shared reference will puke under 5.8.0
+ # ithreads. So we have to fill them in by hand. :(
+ my $empty_result = &share({});
+ for my $idx ( 0..$Expected_Tests-1 ) {
+ $Test_Results[$idx] = $empty_result
+ unless defined $Test_Results[$idx];
+ }
+
+ my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
+ $num_failed += abs($Expected_Tests - @Test_Results);
+
+ if( $Curr_Test < $Expected_Tests ) {
+ my $s = $Expected_Tests == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you planned $Expected_Tests test$s but only ran $Curr_Test.
+FAIL
+ }
+ elsif( $Curr_Test > $Expected_Tests ) {
+ my $num_extra = $Curr_Test - $Expected_Tests;
+ my $s = $Expected_Tests == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you planned $Expected_Tests test$s but ran $num_extra extra.
+FAIL
+ }
+ elsif ( $num_failed ) {
+ my $s = $num_failed == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you failed $num_failed test$s of $Expected_Tests.
+FAIL
+ }
+
+ if( $Test_Died ) {
+ $self->diag(<<"FAIL");
+Looks like your test died just after $Curr_Test.
+FAIL
+
+ _my_exit( 255 ) && return;
+ }
+
+ _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
+ }
+ elsif ( $Skip_All ) {
+ _my_exit( 0 ) && return;
+ }
+ elsif ( $Test_Died ) {
+ $self->diag(<<'FAIL');
+Looks like your test died before it could output anything.
+FAIL
+ _my_exit( 255 ) && return;
+ }
+ else {
+ $self->diag("No tests run!\n");
+ _my_exit( 255 ) && return;
+ }
+}
+
+END {
+ $Test->_ending if defined $Test and !$Test->no_ending;
+}
+
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Builder
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+
+=head1 THREADS
+
+In perl 5.8.0 and later, Test::Builder is thread-safe. The test
+number is shared amongst all threads. This means if one thread sets
+the test number using current_test() they will all be effected.
+
+Test::Builder is only thread-aware if threads.pm is loaded I<before>
+Test::Builder.
+
+=head1 EXAMPLES
+
+CPAN can provide the best examples. Test::Simple, Test::More,
+Test::Exception and Test::Differences all use Test::Builder.
+
+=head1 SEE ALSO
+
+Test::Simple, Test::More, Test::Harness
+
+=head1 AUTHORS
+
+Original code by chromatic, maintained by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
+ Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
diff --git a/cpan/dist/PathTools/t/lib/Test/More.pm b/cpan/dist/PathTools/t/lib/Test/More.pm
new file mode 100644
index 00000000..db16079e
--- /dev/null
+++ b/cpan/dist/PathTools/t/lib/Test/More.pm
@@ -0,0 +1,1330 @@
+package Test::More;
+
+use 5.004;
+
+use strict;
+use Test::Builder;
+
+
+# Can't use Carp because it might cause use_ok() to accidentally succeed
+# even though the module being used forgot to use Carp. Yes, this
+# actually happened.
+sub _carp {
+ my($file, $line) = (caller(1))[1,2];
+ warn @_, " at $file line $line\n";
+}
+
+
+
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
+$VERSION = '0.49';
+@ISA = qw(Exporter);
+@EXPORT = qw(ok use_ok require_ok
+ is isnt like unlike is_deeply
+ cmp_ok
+ skip todo todo_skip
+ pass fail
+ eq_array eq_hash eq_set
+ $TODO
+ plan
+ can_ok isa_ok
+ diag
+ );
+
+my $Test = Test::Builder->new;
+my $Show_Diag = 1;
+
+
+# 5.004's Exporter doesn't have export_to_level.
+sub _export_to_level
+{
+ my $pkg = shift;
+ my $level = shift;
+ (undef) = shift; # redundant arg
+ my $callpkg = caller($level);
+ $pkg->export($callpkg, @_);
+}
+
+
+=head1 NAME
+
+Test::More - yet another framework for writing test scripts
+
+=head1 SYNOPSIS
+
+ use Test::More tests => $Num_Tests;
+ # or
+ use Test::More qw(no_plan);
+ # or
+ use Test::More skip_all => $reason;
+
+ BEGIN { use_ok( 'Some::Module' ); }
+ require_ok( 'Some::Module' );
+
+ # Various ways to say "ok"
+ ok($this eq $that, $test_name);
+
+ is ($this, $that, $test_name);
+ isnt($this, $that, $test_name);
+
+ # Rather than print STDERR "# here's what went wrong\n"
+ diag("here's what went wrong");
+
+ like ($this, qr/that/, $test_name);
+ unlike($this, qr/that/, $test_name);
+
+ cmp_ok($this, '==', $that, $test_name);
+
+ is_deeply($complex_structure1, $complex_structure2, $test_name);
+
+ SKIP: {
+ skip $why, $how_many unless $have_some_feature;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ TODO: {
+ local $TODO = $why;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ can_ok($module, @methods);
+ isa_ok($object, $class);
+
+ pass($test_name);
+ fail($test_name);
+
+ # Utility comparison functions.
+ eq_array(\@this, \@that);
+ eq_hash(\%this, \%that);
+ eq_set(\@this, \@that);
+
+ # UNIMPLEMENTED!!!
+ my @status = Test::More::status;
+
+ # UNIMPLEMENTED!!!
+ BAIL_OUT($why);
+
+
+=head1 DESCRIPTION
+
+B<STOP!> If you're just getting started writing tests, have a look at
+Test::Simple first. This is a drop in replacement for Test::Simple
+which you can switch to once you get the hang of basic testing.
+
+The purpose of this module is to provide a wide range of testing
+utilities. Various ways to say "ok" with better diagnostics,
+facilities to skip tests, test future features and compare complicated
+data structures. While you can do almost anything with a simple
+C<ok()> function, it doesn't provide good diagnostic output.
+
+
+=head2 I love it when a plan comes together
+
+Before anything else, you need a testing plan. This basically declares
+how many tests your script is going to run to protect against premature
+failure.
+
+The preferred way to do this is to declare a plan when you C<use Test::More>.
+
+ use Test::More tests => $Num_Tests;
+
+There are rare cases when you will not know beforehand how many tests
+your script is going to run. In this case, you can declare that you
+have no plan. (Try to avoid using this as it weakens your test.)
+
+ use Test::More qw(no_plan);
+
+B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
+think everything has failed. See L<BUGS and CAVEATS>)
+
+In some cases, you'll want to completely skip an entire testing script.
+
+ use Test::More skip_all => $skip_reason;
+
+Your script will declare a skip with the reason why you skipped and
+exit immediately with a zero (success). See L<Test::Harness> for
+details.
+
+If you want to control what functions Test::More will export, you
+have to use the 'import' option. For example, to import everything
+but 'fail', you'd do:
+
+ use Test::More tests => 23, import => ['!fail'];
+
+Alternatively, you can use the plan() function. Useful for when you
+have to calculate the number of tests.
+
+ use Test::More;
+ plan tests => keys %Stuff * 3;
+
+or for deciding between running the tests at all:
+
+ use Test::More;
+ if( $^O eq 'MacOS' ) {
+ plan skip_all => 'Test irrelevant on MacOS';
+ }
+ else {
+ plan tests => 42;
+ }
+
+=cut
+
+sub plan {
+ my(@plan) = @_;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+
+ my @cleaned_plan;
+ my @imports = ();
+ my $idx = 0;
+ while( $idx <= $#plan ) {
+ if( $plan[$idx] eq 'import' ) {
+ @imports = @{$plan[$idx+1]};
+ $idx += 2;
+ }
+ elsif( $plan[$idx] eq 'no_diag' ) {
+ $Show_Diag = 0;
+ $idx++;
+ }
+ else {
+ push @cleaned_plan, $plan[$idx];
+ $idx++;
+ }
+ }
+
+ $Test->plan(@cleaned_plan);
+
+ __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+sub import {
+ my($class) = shift;
+ goto &plan;
+}
+
+
+=head2 Test names
+
+By convention, each test is assigned a number in order. This is
+largely done automatically for you. However, it's often very useful to
+assign a name to each test. Which would you rather see:
+
+ ok 4
+ not ok 5
+ ok 6
+
+or
+
+ ok 4 - basic multi-variable
+ not ok 5 - simple exponential
+ ok 6 - force == mass * acceleration
+
+The later gives you some idea of what failed. It also makes it easier
+to find the test in your script, simply search for "simple
+exponential".
+
+All test functions take a name argument. It's optional, but highly
+suggested that you use it.
+
+
+=head2 I'm ok, you're not ok.
+
+The basic purpose of this module is to print out either "ok #" or "not
+ok #" depending on if a given test succeeded or failed. Everything
+else is just gravy.
+
+All of the following print "ok" or "not ok" depending on if the test
+succeeded or failed. They all also return true or false,
+respectively.
+
+=over 4
+
+=item B<ok>
+
+ ok($this eq $that, $test_name);
+
+This simply evaluates any expression (C<$this eq $that> is just a
+simple example) and uses that to determine if the test succeeded or
+failed. A true expression passes, a false one fails. Very simple.
+
+For example:
+
+ ok( $exp{9} == 81, 'simple exponential' );
+ ok( Film->can('db_Main'), 'set_db()' );
+ ok( $p->tests == 4, 'saw tests' );
+ ok( !grep !defined $_, @items, 'items populated' );
+
+(Mnemonic: "This is ok.")
+
+$test_name is a very short description of the test that will be printed
+out. It makes it very easy to find a test in your script when it fails
+and gives others an idea of your intentions. $test_name is optional,
+but we B<very> strongly encourage its use.
+
+Should an ok() fail, it will produce some diagnostics:
+
+ not ok 18 - sufficient mucus
+ # Failed test 18 (foo.t at line 42)
+
+This is actually Test::Simple's ok() routine.
+
+=cut
+
+sub ok ($;$) {
+ my($test, $name) = @_;
+ $Test->ok($test, $name);
+}
+
+=item B<is>
+
+=item B<isnt>
+
+ is ( $this, $that, $test_name );
+ isnt( $this, $that, $test_name );
+
+Similar to ok(), is() and isnt() compare their two arguments
+with C<eq> and C<ne> respectively and use the result of that to
+determine if the test succeeded or failed. So these:
+
+ # Is the ultimate answer 42?
+ is( ultimate_answer(), 42, "Meaning of Life" );
+
+ # $foo isn't empty
+ isnt( $foo, '', "Got some foo" );
+
+are similar to these:
+
+ ok( ultimate_answer() eq 42, "Meaning of Life" );
+ ok( $foo ne '', "Got some foo" );
+
+(Mnemonic: "This is that." "This isn't that.")
+
+So why use these? They produce better diagnostics on failure. ok()
+cannot know what you are testing for (beyond the name), but is() and
+isnt() know what the test was and why it failed. For example this
+test:
+
+ my $foo = 'waffle'; my $bar = 'yarblokos';
+ is( $foo, $bar, 'Is foo the same as bar?' );
+
+Will produce something like this:
+
+ not ok 17 - Is foo the same as bar?
+ # Failed test (foo.t at line 139)
+ # got: 'waffle'
+ # expected: 'yarblokos'
+
+So you can figure out what went wrong without rerunning the test.
+
+You are encouraged to use is() and isnt() over ok() where possible,
+however do not be tempted to use them to find out if something is
+true or false!
+
+ # XXX BAD!
+ is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
+
+This does not check if C<exists $brooklyn{tree}> is true, it checks if
+it returns 1. Very different. Similar caveats exist for false and 0.
+In these cases, use ok().
+
+ ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
+
+For those grammatical pedants out there, there's an C<isn't()>
+function which is an alias of isnt().
+
+=cut
+
+sub is ($$;$) {
+ $Test->is_eq(@_);
+}
+
+sub isnt ($$;$) {
+ $Test->isnt_eq(@_);
+}
+
+*isn't = \&isnt;
+
+
+=item B<like>
+
+ like( $this, qr/that/, $test_name );
+
+Similar to ok(), like() matches $this against the regex C<qr/that/>.
+
+So this:
+
+ like($this, qr/that/, 'this is like that');
+
+is similar to:
+
+ ok( $this =~ /that/, 'this is like that');
+
+(Mnemonic "This is like that".)
+
+The second argument is a regular expression. It may be given as a
+regex reference (i.e. C<qr//>) or (for better compatibility with older
+perls) as a string that looks like a regex (alternative delimiters are
+currently not supported):
+
+ like( $this, '/that/', 'this is like that' );
+
+Regex options may be placed on the end (C<'/that/i'>).
+
+Its advantages over ok() are similar to that of is() and isnt(). Better
+diagnostics on failure.
+
+=cut
+
+sub like ($$;$) {
+ $Test->like(@_);
+}
+
+
+=item B<unlike>
+
+ unlike( $this, qr/that/, $test_name );
+
+Works exactly as like(), only it checks if $this B<does not> match the
+given pattern.
+
+=cut
+
+sub unlike ($$;$) {
+ $Test->unlike(@_);
+}
+
+
+=item B<cmp_ok>
+
+ cmp_ok( $this, $op, $that, $test_name );
+
+Halfway between ok() and is() lies cmp_ok(). This allows you to
+compare two arguments using any binary perl operator.
+
+ # ok( $this eq $that );
+ cmp_ok( $this, 'eq', $that, 'this eq that' );
+
+ # ok( $this == $that );
+ cmp_ok( $this, '==', $that, 'this == that' );
+
+ # ok( $this && $that );
+ cmp_ok( $this, '&&', $that, 'this && that' );
+ ...etc...
+
+Its advantage over ok() is when the test fails you'll know what $this
+and $that were:
+
+ not ok 1
+ # Failed test (foo.t at line 12)
+ # '23'
+ # &&
+ # undef
+
+It's also useful in those cases where you are comparing numbers and
+is()'s use of C<eq> will interfere:
+
+ cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
+
+=cut
+
+sub cmp_ok($$$;$) {
+ $Test->cmp_ok(@_);
+}
+
+
+=item B<can_ok>
+
+ can_ok($module, @methods);
+ can_ok($object, @methods);
+
+Checks to make sure the $module or $object can do these @methods
+(works with functions, too).
+
+ can_ok('Foo', qw(this that whatever));
+
+is almost exactly like saying:
+
+ ok( Foo->can('this') &&
+ Foo->can('that') &&
+ Foo->can('whatever')
+ );
+
+only without all the typing and with a better interface. Handy for
+quickly testing an interface.
+
+No matter how many @methods you check, a single can_ok() call counts
+as one test. If you desire otherwise, use:
+
+ foreach my $meth (@methods) {
+ can_ok('Foo', $meth);
+ }
+
+=cut
+
+sub can_ok ($@) {
+ my($proto, @methods) = @_;
+ my $class = ref $proto || $proto;
+
+ unless( @methods ) {
+ my $ok = $Test->ok( 0, "$class->can(...)" );
+ $Test->diag(' can_ok() called with no methods');
+ return $ok;
+ }
+
+ my @nok = ();
+ foreach my $method (@methods) {
+ local($!, $@); # don't interfere with caller's $@
+ # eval sometimes resets $!
+ eval { $proto->can($method) } || push @nok, $method;
+ }
+
+ my $name;
+ $name = @methods == 1 ? "$class->can('$methods[0]')"
+ : "$class->can(...)";
+
+ my $ok = $Test->ok( !@nok, $name );
+
+ $Test->diag(map " $class->can('$_') failed\n", @nok);
+
+ return $ok;
+}
+
+=item B<isa_ok>
+
+ isa_ok($object, $class, $object_name);
+ isa_ok($ref, $type, $ref_name);
+
+Checks to see if the given C<< $object->isa($class) >>. Also checks to make
+sure the object was defined in the first place. Handy for this sort
+of thing:
+
+ my $obj = Some::Module->new;
+ isa_ok( $obj, 'Some::Module' );
+
+where you'd otherwise have to write
+
+ my $obj = Some::Module->new;
+ ok( defined $obj && $obj->isa('Some::Module') );
+
+to safeguard against your test script blowing up.
+
+It works on references, too:
+
+ isa_ok( $array_ref, 'ARRAY' );
+
+The diagnostics of this test normally just refer to 'the object'. If
+you'd like them to be more specific, you can supply an $object_name
+(for example 'Test customer').
+
+=cut
+
+sub isa_ok ($$;$) {
+ my($object, $class, $obj_name) = @_;
+
+ my $diag;
+ $obj_name = 'The object' unless defined $obj_name;
+ my $name = "$obj_name isa $class";
+ if( !defined $object ) {
+ $diag = "$obj_name isn't defined";
+ }
+ elsif( !ref $object ) {
+ $diag = "$obj_name isn't a reference";
+ }
+ else {
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ local($@, $!); # eval sometimes resets $!
+ my $rslt = eval { $object->isa($class) };
+ if( $@ ) {
+ if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ if( !UNIVERSAL::isa($object, $class) ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ } else {
+ die <<WHOA;
+WHOA! I tried to call ->isa on your object and got some weird error.
+This should never happen. Please contact the author immediately.
+Here's the error.
+$@
+WHOA
+ }
+ }
+ elsif( !$rslt ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ }
+
+
+
+ my $ok;
+ if( $diag ) {
+ $ok = $Test->ok( 0, $name );
+ $Test->diag(" $diag\n");
+ }
+ else {
+ $ok = $Test->ok( 1, $name );
+ }
+
+ return $ok;
+}
+
+
+=item B<pass>
+
+=item B<fail>
+
+ pass($test_name);
+ fail($test_name);
+
+Sometimes you just want to say that the tests have passed. Usually
+the case is you've got some complicated condition that is difficult to
+wedge into an ok(). In this case, you can simply use pass() (to
+declare the test ok) or fail (for not ok). They are synonyms for
+ok(1) and ok(0).
+
+Use these very, very, very sparingly.
+
+=cut
+
+sub pass (;$) {
+ $Test->ok(1, @_);
+}
+
+sub fail (;$) {
+ $Test->ok(0, @_);
+}
+
+=back
+
+=head2 Diagnostics
+
+If you pick the right test function, you'll usually get a good idea of
+what went wrong when it failed. But sometimes it doesn't work out
+that way. So here we have ways for you to write your own diagnostic
+messages which are safer than just C<print STDERR>.
+
+=over 4
+
+=item B<diag>
+
+ diag(@diagnostic_message);
+
+Prints a diagnostic message which is guaranteed not to interfere with
+test output. Handy for this sort of thing:
+
+ ok( grep(/foo/, @users), "There's a foo user" ) or
+ diag("Since there's no foo, check that /etc/bar is set up right");
+
+which would produce:
+
+ not ok 42 - There's a foo user
+ # Failed test (foo.t at line 52)
+ # Since there's no foo, check that /etc/bar is set up right.
+
+You might remember C<ok() or diag()> with the mnemonic C<open() or
+die()>.
+
+All diag()s can be made silent by passing the "no_diag" option to
+Test::More. C<use Test::More tests => 1, 'no_diag'>. This is useful
+if you have diagnostics for personal testing but then wish to make
+them silent for release without commenting out each individual
+statement.
+
+B<NOTE> The exact formatting of the diagnostic output is still
+changing, but it is guaranteed that whatever you throw at it it won't
+interfere with the test.
+
+=cut
+
+sub diag {
+ return unless $Show_Diag;
+ $Test->diag(@_);
+}
+
+
+=back
+
+=head2 Module tests
+
+You usually want to test if the module you're testing loads ok, rather
+than just vomiting if its load fails. For such purposes we have
+C<use_ok> and C<require_ok>.
+
+=over 4
+
+=item B<use_ok>
+
+ BEGIN { use_ok($module); }
+ BEGIN { use_ok($module, @imports); }
+
+These simply use the given $module and test to make sure the load
+happened ok. It's recommended that you run use_ok() inside a BEGIN
+block so its functions are exported at compile-time and prototypes are
+properly honored.
+
+If @imports are given, they are passed through to the use. So this:
+
+ BEGIN { use_ok('Some::Module', qw(foo bar)) }
+
+is like doing this:
+
+ use Some::Module qw(foo bar);
+
+Version numbers can be checked like so:
+
+ # Just like "use Some::Module 1.02"
+ BEGIN { use_ok('Some::Module', 1.02) }
+
+Don't try to do this:
+
+ BEGIN {
+ use_ok('Some::Module');
+
+ ...some code that depends on the use...
+ ...happening at compile time...
+ }
+
+because the notion of "compile-time" is relative. Instead, you want:
+
+ BEGIN { use_ok('Some::Module') }
+ BEGIN { ...some code that depends on the use... }
+
+
+=cut
+
+sub use_ok ($;@) {
+ my($module, @imports) = @_;
+ @imports = () unless @imports;
+
+ my($pack,$filename,$line) = caller;
+
+ local($@,$!); # eval sometimes interferes with $!
+
+ if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+ # probably a version check. Perl needs to see the bare number
+ # for it to work with non-Exporter based modules.
+ eval <<USE;
+package $pack;
+use $module $imports[0];
+USE
+ }
+ else {
+ eval <<USE;
+package $pack;
+use $module \@imports;
+USE
+ }
+
+ my $ok = $Test->ok( !$@, "use $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $@ =~ s{^BEGIN failed--compilation aborted at .*$}
+ {BEGIN failed--compilation aborted at $filename line $line.}m;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to use '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<require_ok>
+
+ require_ok($module);
+
+Like use_ok(), except it requires the $module.
+
+=cut
+
+sub require_ok ($) {
+ my($module) = shift;
+
+ my $pack = caller;
+
+ local($!, $@); # eval sometimes interferes with $!
+ eval <<REQUIRE;
+package $pack;
+require $module;
+REQUIRE
+
+ my $ok = $Test->ok( !$@, "require $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to require '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=back
+
+=head2 Conditional tests
+
+Sometimes running a test under certain conditions will cause the
+test script to die. A certain function or method isn't implemented
+(such as fork() on MacOS), some resource isn't available (like a
+net connection) or a module isn't available. In these cases it's
+necessary to skip tests, or declare that they are supposed to fail
+but will work in the future (a todo test).
+
+For more details on the mechanics of skip and todo tests see
+L<Test::Harness>.
+
+The way Test::More handles this is with a named block. Basically, a
+block of tests which can be skipped over or made todo. It's best if I
+just show you...
+
+=over 4
+
+=item B<SKIP: BLOCK>
+
+ SKIP: {
+ skip $why, $how_many if $condition;
+
+ ...normal testing code goes here...
+ }
+
+This declares a block of tests that might be skipped, $how_many tests
+there are, $why and under what $condition to skip them. An example is
+the easiest way to illustrate:
+
+ SKIP: {
+ eval { require HTML::Lint };
+
+ skip "HTML::Lint not installed", 2 if $@;
+
+ my $lint = new HTML::Lint;
+ isa_ok( $lint, "HTML::Lint" );
+
+ $lint->parse( $html );
+ is( $lint->errors, 0, "No errors found in HTML" );
+ }
+
+If the user does not have HTML::Lint installed, the whole block of
+code I<won't be run at all>. Test::More will output special ok's
+which Test::Harness interprets as skipped, but passing, tests.
+It's important that $how_many accurately reflects the number of tests
+in the SKIP block so the # of tests run will match up with your plan.
+
+It's perfectly safe to nest SKIP blocks. Each SKIP block must have
+the label C<SKIP>, or Test::More can't work its magic.
+
+You don't skip tests which are failing because there's a bug in your
+program, or for which you don't yet have code written. For that you
+use TODO. Read on.
+
+=cut
+
+#'#
+sub skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "skip() needs to know \$how_many tests are in the block"
+ unless $Test::Builder::No_Plan;
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->skip($why);
+ }
+
+ local $^W = 0;
+ last SKIP;
+}
+
+
+=item B<TODO: BLOCK>
+
+ TODO: {
+ local $TODO = $why if $condition;
+
+ ...normal testing code goes here...
+ }
+
+Declares a block of tests you expect to fail and $why. Perhaps it's
+because you haven't fixed a bug or haven't finished a new feature:
+
+ TODO: {
+ local $TODO = "URI::Geller not finished";
+
+ my $card = "Eight of clubs";
+ is( URI::Geller->your_card, $card, 'Is THIS your card?' );
+
+ my $spoon;
+ URI::Geller->bend_spoon;
+ is( $spoon, 'bent', "Spoon bending, that's original" );
+ }
+
+With a todo block, the tests inside are expected to fail. Test::More
+will run the tests normally, but print out special flags indicating
+they are "todo". Test::Harness will interpret failures as being ok.
+Should anything succeed, it will report it as an unexpected success.
+You then know the thing you had todo is done and can remove the
+TODO flag.
+
+The nice part about todo tests, as opposed to simply commenting out a
+block of tests, is it's like having a programmatic todo list. You know
+how much work is left to be done, you're aware of what bugs there are,
+and you'll know immediately when they're fixed.
+
+Once a todo test starts succeeding, simply move it outside the block.
+When the block is empty, delete it.
+
+B<NOTE>: TODO tests require a Test::Harness upgrade else it will
+treat it as a normal failure. See L<BUGS and CAVEATS>)
+
+
+=item B<todo_skip>
+
+ TODO: {
+ todo_skip $why, $how_many if $condition;
+
+ ...normal testing code...
+ }
+
+With todo tests, it's best to have the tests actually run. That way
+you'll know when they start passing. Sometimes this isn't possible.
+Often a failing test will cause the whole program to die or hang, even
+inside an C<eval BLOCK> with and using C<alarm>. In these extreme
+cases you have no choice but to skip over the broken tests entirely.
+
+The syntax and behavior is similar to a C<SKIP: BLOCK> except the
+tests will be marked as failing but todo. Test::Harness will
+interpret them as passing.
+
+=cut
+
+sub todo_skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "todo_skip() needs to know \$how_many tests are in the block"
+ unless $Test::Builder::No_Plan;
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->todo_skip($why);
+ }
+
+ local $^W = 0;
+ last TODO;
+}
+
+=item When do I use SKIP vs. TODO?
+
+B<If it's something the user might not be able to do>, use SKIP.
+This includes optional modules that aren't installed, running under
+an OS that doesn't have some feature (like fork() or symlinks), or maybe
+you need an Internet connection and one isn't available.
+
+B<If it's something the programmer hasn't done yet>, use TODO. This
+is for any code you haven't written yet, or bugs you have yet to fix,
+but want to put tests in your testing script (always a good idea).
+
+
+=back
+
+=head2 Comparison functions
+
+Not everything is a simple eq check or regex. There are times you
+need to see if two arrays are equivalent, for instance. For these
+instances, Test::More provides a handful of useful functions.
+
+B<NOTE> These are NOT well-tested on circular references. Nor am I
+quite sure what will happen with filehandles.
+
+=over 4
+
+=item B<is_deeply>
+
+ is_deeply( $this, $that, $test_name );
+
+Similar to is(), except that if $this and $that are hash or array
+references, it does a deep comparison walking each data structure to
+see if they are equivalent. If the two structures are different, it
+will display the place where they start differing.
+
+Test::Differences and Test::Deep provide more in-depth functionality
+along these lines.
+
+=cut
+
+use vars qw(@Data_Stack);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+ unless( @_ == 2 or @_ == 3 ) {
+ my $msg = <<WARNING;
+is_deeply() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead
+of a reference to it
+WARNING
+ chop $msg; # clip off newline so carp() will put in line/file
+
+ _carp sprintf $msg, scalar @_;
+ }
+
+ my($this, $that, $name) = @_;
+
+ my $ok;
+ if( !ref $this || !ref $that ) {
+ $ok = $Test->is_eq($this, $that, $name);
+ }
+ else {
+ local @Data_Stack = ();
+ if( _deep_check($this, $that) ) {
+ $ok = $Test->ok(1, $name);
+ }
+ else {
+ $ok = $Test->ok(0, $name);
+ $ok = $Test->diag(_format_stack(@Data_Stack));
+ }
+ }
+
+ return $ok;
+}
+
+sub _format_stack {
+ my(@Stack) = @_;
+
+ my $var = '$FOO';
+ my $did_arrow = 0;
+ foreach my $entry (@Stack) {
+ my $type = $entry->{type} || '';
+ my $idx = $entry->{'idx'};
+ if( $type eq 'HASH' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "{$idx}";
+ }
+ elsif( $type eq 'ARRAY' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "[$idx]";
+ }
+ elsif( $type eq 'REF' ) {
+ $var = "\${$var}";
+ }
+ }
+
+ my @vals = @{$Stack[-1]{vals}}[0,1];
+ my @vars = ();
+ ($vars[0] = $var) =~ s/\$FOO/ \$got/;
+ ($vars[1] = $var) =~ s/\$FOO/\$expected/;
+
+ my $out = "Structures begin differing at:\n";
+ foreach my $idx (0..$#vals) {
+ my $val = $vals[$idx];
+ $vals[$idx] = !defined $val ? 'undef' :
+ $val eq $DNE ? "Does not exist"
+ : "'$val'";
+ }
+
+ $out .= "$vars[0] = $vals[0]\n";
+ $out .= "$vars[1] = $vals[1]\n";
+
+ $out =~ s/^/ /msg;
+ return $out;
+}
+
+
+=item B<eq_array>
+
+ eq_array(\@this, \@that);
+
+Checks if two arrays are equivalent. This is a deep check, so
+multi-level structures are handled correctly.
+
+=cut
+
+#'#
+sub eq_array {
+ my($a1, $a2) = @_;
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0..$max) {
+ my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+
+ push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
+ $ok = _deep_check($e1,$e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+ return $ok;
+}
+
+sub _deep_check {
+ my($e1, $e2) = @_;
+ my $ok = 0;
+
+ my $eq;
+ {
+ # Quiet uninitialized value warnings when comparing undefs.
+ local $^W = 0;
+
+ if( $e1 eq $e2 ) {
+ $ok = 1;
+ }
+ else {
+ if( UNIVERSAL::isa($e1, 'ARRAY') and
+ UNIVERSAL::isa($e2, 'ARRAY') )
+ {
+ $ok = eq_array($e1, $e2);
+ }
+ elsif( UNIVERSAL::isa($e1, 'HASH') and
+ UNIVERSAL::isa($e2, 'HASH') )
+ {
+ $ok = eq_hash($e1, $e2);
+ }
+ elsif( UNIVERSAL::isa($e1, 'REF') and
+ UNIVERSAL::isa($e2, 'REF') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ elsif( UNIVERSAL::isa($e1, 'SCALAR') and
+ UNIVERSAL::isa($e2, 'SCALAR') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ }
+ else {
+ push @Data_Stack, { vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ }
+ }
+
+ return $ok;
+}
+
+
+=item B<eq_hash>
+
+ eq_hash(\%this, \%that);
+
+Determines if the two hashes contain the same keys and values. This
+is a deep check.
+
+=cut
+
+sub eq_hash {
+ my($a1, $a2) = @_;
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ foreach my $k (keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+
+ push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
+ $ok = _deep_check($e1, $e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+=item B<eq_set>
+
+ eq_set(\@this, \@that);
+
+Similar to eq_array(), except the order of the elements is B<not>
+important. This is a deep check, but the irrelevancy of order only
+applies to the top level.
+
+B<NOTE> By historical accident, this is not a true set comparision.
+While the order of elements does not matter, duplicate elements do.
+
+=cut
+
+# We must make sure that references are treated neutrally. It really
+# doesn't matter how we sort them, as long as both arrays are sorted
+# with the same algorithm.
+sub _bogus_sort { local $^W = 0; ref $a ? -1 : ref $b ? 1 : $a cmp $b }
+
+sub eq_set {
+ my($a1, $a2) = @_;
+ return 0 unless @$a1 == @$a2;
+
+ # There's faster ways to do this, but this is easiest.
+ return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
+}
+
+=back
+
+
+=head2 Extending and Embedding Test::More
+
+Sometimes the Test::More interface isn't quite enough. Fortunately,
+Test::More is built on top of Test::Builder which provides a single,
+unified backend for any test library to use. This means two test
+libraries which both use Test::Builder B<can be used together in the
+same program>.
+
+If you simply want to do a little tweaking of how the tests behave,
+you can access the underlying Test::Builder object like so:
+
+=over 4
+
+=item B<builder>
+
+ my $test_builder = Test::More->builder;
+
+Returns the Test::Builder object underlying Test::More for you to play
+with.
+
+=cut
+
+sub builder {
+ return Test::Builder->new;
+}
+
+=back
+
+
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Builder
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+
+=head1 NOTES
+
+Test::More is B<explicitly> tested all the way back to perl 5.004.
+
+=head1 BUGS and CAVEATS
+
+=over 4
+
+=item Threads
+
+Test::More will only be aware of threads if "use threads" has been done
+I<before> Test::More is loaded. This is ok:
+
+ use threads;
+ use Test::More;
+
+This may cause problems:
+
+ use Test::More
+ use threads;
+
+=item Making your own ok()
+
+If you are trying to extend Test::More, don't. Use Test::Builder
+instead.
+
+=item The eq_* family has some caveats.
+
+=item Test::Harness upgrade
+
+no_plan and todo depend on new Test::Harness features and fixes. If
+you're going to distribute tests that use no_plan or todo your
+end-users will have to upgrade Test::Harness to the latest one on
+CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
+will work fine.
+
+Installing Test::More should also upgrade Test::Harness.
+
+=back
+
+
+=head1 HISTORY
+
+This is a case of convergent evolution with Joshua Pritikin's Test
+module. I was largely unaware of its existence when I'd first
+written my own ok() routines. This module exists because I can't
+figure out how to easily wedge test names into Test's interface (along
+with a few other problems).
+
+The goal here is to have a testing utility that's simple to learn,
+quick to use and difficult to trip yourself up with while still
+providing more flexibility than the existing Test.pm. As such, the
+names of the most common routines are kept tiny, special cases and
+magic side-effects are kept to a minimum. WYSIWYG.
+
+
+=head1 SEE ALSO
+
+L<Test::Simple> if all this confuses you and you just want to write
+some tests. You can upgrade to Test::More later (it's forward
+compatible).
+
+L<Test> is the old testing module. Its main benefit is that it has
+been distributed with Perl since 5.004_05.
+
+L<Test::Harness> for details on how your test results are interpreted
+by Perl.
+
+L<Test::Differences> for more ways to test complex data structures.
+And it plays well with Test::More.
+
+L<Test::Class> is like XUnit but more perlish.
+
+L<Test::Deep> gives you more powerful complex data structure testing.
+
+L<Test::Unit> is XUnit style testing.
+
+L<Test::Inline> shows the idea of embedded testing.
+
+L<Bundle::Test> installs a whole bunch of useful test modules.
+
+
+=head1 AUTHORS
+
+Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
+from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic and the perl-qa gang.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001, 2002 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
diff --git a/cpan/dist/PathTools/t/lib/Test/Simple.pm b/cpan/dist/PathTools/t/lib/Test/Simple.pm
new file mode 100644
index 00000000..d7c5cbe9
--- /dev/null
+++ b/cpan/dist/PathTools/t/lib/Test/Simple.pm
@@ -0,0 +1,235 @@
+package Test::Simple;
+
+use 5.004;
+
+use strict 'vars';
+use vars qw($VERSION);
+$VERSION = '0.49';
+
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+sub import {
+ my $self = shift;
+ my $caller = caller;
+ *{$caller.'::ok'} = \&ok;
+
+ $Test->exported_to($caller);
+ $Test->plan(@_);
+}
+
+
+=head1 NAME
+
+Test::Simple - Basic utilities for writing tests.
+
+=head1 SYNOPSIS
+
+ use Test::Simple tests => 1;
+
+ ok( $foo eq $bar, 'foo is bar' );
+
+
+=head1 DESCRIPTION
+
+** If you are unfamiliar with testing B<read Test::Tutorial> first! **
+
+This is an extremely simple, extremely basic module for writing tests
+suitable for CPAN modules and other pursuits. If you wish to do more
+complicated testing, use the Test::More module (a drop-in replacement
+for this one).
+
+The basic unit of Perl testing is the ok. For each thing you want to
+test your program will print out an "ok" or "not ok" to indicate pass
+or fail. You do this with the ok() function (see below).
+
+The only other constraint is you must pre-declare how many tests you
+plan to run. This is in case something goes horribly wrong during the
+test and your test program aborts, or skips a test or whatever. You
+do this like so:
+
+ use Test::Simple tests => 23;
+
+You must have a plan.
+
+
+=over 4
+
+=item B<ok>
+
+ ok( $foo eq $bar, $name );
+ ok( $foo eq $bar );
+
+ok() is given an expression (in this case C<$foo eq $bar>). If it's
+true, the test passed. If it's false, it didn't. That's about it.
+
+ok() prints out either "ok" or "not ok" along with a test number (it
+keeps track of that for you).
+
+ # This produces "ok 1 - Hell not yet frozen over" (or not ok)
+ ok( get_temperature($hell) > 0, 'Hell not yet frozen over' );
+
+If you provide a $name, that will be printed along with the "ok/not
+ok" to make it easier to find your test when if fails (just search for
+the name). It also makes it easier for the next guy to understand
+what your test is for. It's highly recommended you use test names.
+
+All tests are run in scalar context. So this:
+
+ ok( @stuff, 'I have some stuff' );
+
+will do what you mean (fail if stuff is empty)
+
+=cut
+
+sub ok ($;$) {
+ $Test->ok(@_);
+}
+
+
+=back
+
+Test::Simple will start by printing number of tests run in the form
+"1..M" (so "1..5" means you're going to run 5 tests). This strange
+format lets Test::Harness know how many tests you plan on running in
+case something goes horribly wrong.
+
+If all your tests passed, Test::Simple will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Simple
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+This module is by no means trying to be a complete testing system.
+It's just to get you started. Once you're off the ground its
+recommended you look at L<Test::More>.
+
+
+=head1 EXAMPLE
+
+Here's an example of a simple .t file for the fictional Film module.
+
+ use Test::Simple tests => 5;
+
+ use Film; # What you're testing.
+
+ my $btaste = Film->new({ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 1
+ });
+ ok( defined($btaste) and ref $btaste eq 'Film', 'new() works' );
+
+ ok( $btaste->Title eq 'Bad Taste', 'Title() get' );
+ ok( $btaste->Director eq 'Peter Jackson', 'Director() get' );
+ ok( $btaste->Rating eq 'R', 'Rating() get' );
+ ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' );
+
+It will produce output like this:
+
+ 1..5
+ ok 1 - new() works
+ ok 2 - Title() get
+ ok 3 - Director() get
+ not ok 4 - Rating() get
+ # Failed test (t/film.t at line 14)
+ ok 5 - NumExplodingSheep() get
+ # Looks like you failed 1 tests of 5
+
+Indicating the Film::Rating() method is broken.
+
+
+=head1 CAVEATS
+
+Test::Simple will only report a maximum of 254 failures in its exit
+code. If this is a problem, you probably have a huge test script.
+Split it into multiple files. (Otherwise blame the Unix folks for
+using an unsigned short integer as the exit status).
+
+Because VMS's exit codes are much, much different than the rest of the
+universe, and perl does horrible mangling to them that gets in my way,
+it works like this on VMS.
+
+ 0 SS$_NORMAL all tests successful
+ 4 SS$_ABORT something went wrong
+
+Unfortunately, I can't differentiate any further.
+
+
+=head1 NOTES
+
+Test::Simple is B<explicitly> tested all the way back to perl 5.004.
+
+Test::Simple is thread-safe in perl 5.8.0 and up.
+
+=head1 HISTORY
+
+This module was conceived while talking with Tony Bowden in his
+kitchen one night about the problems I was having writing some really
+complicated feature into the new Testing module. He observed that the
+main problem is not dealing with these edge cases but that people hate
+to write tests B<at all>. What was needed was a dead simple module
+that took all the hard work out of testing and was really, really easy
+to learn. Paul Johnson simultaneously had this idea (unfortunately,
+he wasn't in Tony's kitchen). This is it.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::More>
+
+More testing functions! Once you outgrow Test::Simple, look at
+Test::More. Test::Simple is 100% forward compatible with Test::More
+(i.e. you can just use Test::More instead of Test::Simple in your
+programs and things will still work).
+
+=item L<Test>
+
+The original Perl testing module.
+
+=item L<Test::Unit>
+
+Elaborate unit testing.
+
+=item L<Test::Inline>, L<SelfTest>
+
+Embed tests in your code!
+
+=item L<Test::Harness>
+
+Interprets the output of your test program.
+
+=back
+
+
+=head1 AUTHORS
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
diff --git a/cpan/dist/PathTools/t/lib/Test/Tutorial.pod b/cpan/dist/PathTools/t/lib/Test/Tutorial.pod
new file mode 100644
index 00000000..7a6c084d
--- /dev/null
+++ b/cpan/dist/PathTools/t/lib/Test/Tutorial.pod
@@ -0,0 +1,603 @@
+=head1 NAME
+
+Test::Tutorial - A tutorial about writing really basic tests
+
+=head1 DESCRIPTION
+
+
+I<AHHHHHHH!!!! NOT TESTING! Anything but testing!
+Beat me, whip me, send me to Detroit, but don't make
+me write tests!>
+
+I<*sob*>
+
+I<Besides, I don't know how to write the damned things.>
+
+
+Is this you? Is writing tests right up there with writing
+documentation and having your fingernails pulled out? Did you open up
+a test and read
+
+ ######## We start with some black magic
+
+and decide that's quite enough for you?
+
+It's ok. That's all gone now. We've done all the black magic for
+you. And here are the tricks...
+
+
+=head2 Nuts and bolts of testing.
+
+Here's the most basic test program.
+
+ #!/usr/bin/perl -w
+
+ print "1..1\n";
+
+ print 1 + 1 == 2 ? "ok 1\n" : "not ok 1\n";
+
+since 1 + 1 is 2, it prints:
+
+ 1..1
+ ok 1
+
+What this says is: C<1..1> "I'm going to run one test." [1] C<ok 1>
+"The first test passed". And that's about all magic there is to
+testing. Your basic unit of testing is the I<ok>. For each thing you
+test, an C<ok> is printed. Simple. B<Test::Harness> interprets your test
+results to determine if you succeeded or failed (more on that later).
+
+Writing all these print statements rapidly gets tedious. Fortunately,
+there's B<Test::Simple>. It has one function, C<ok()>.
+
+ #!/usr/bin/perl -w
+
+ use Test::Simple tests => 1;
+
+ ok( 1 + 1 == 2 );
+
+and that does the same thing as the code above. C<ok()> is the backbone
+of Perl testing, and we'll be using it instead of roll-your-own from
+here on. If C<ok()> gets a true value, the test passes. False, it
+fails.
+
+ #!/usr/bin/perl -w
+
+ use Test::Simple tests => 2;
+ ok( 1 + 1 == 2 );
+ ok( 2 + 2 == 5 );
+
+from that comes
+
+ 1..2
+ ok 1
+ not ok 2
+ # Failed test (test.pl at line 5)
+ # Looks like you failed 1 tests of 2.
+
+C<1..2> "I'm going to run two tests." This number is used to ensure
+your test program ran all the way through and didn't die or skip some
+tests. C<ok 1> "The first test passed." C<not ok 2> "The second test
+failed". Test::Simple helpfully prints out some extra commentary about
+your tests.
+
+It's not scary. Come, hold my hand. We're going to give an example
+of testing a module. For our example, we'll be testing a date
+library, B<Date::ICal>. It's on CPAN, so download a copy and follow
+along. [2]
+
+
+=head2 Where to start?
+
+This is the hardest part of testing, where do you start? People often
+get overwhelmed at the apparent enormity of the task of testing a
+whole module. Best place to start is at the beginning. Date::ICal is
+an object-oriented module, and that means you start by making an
+object. So we test C<new()>.
+
+ #!/usr/bin/perl -w
+
+ use Test::Simple tests => 2;
+
+ use Date::ICal;
+
+ my $ical = Date::ICal->new; # create an object
+ ok( defined $ical ); # check that we got something
+ ok( $ical->isa('Date::ICal') ); # and it's the right class
+
+run that and you should get:
+
+ 1..2
+ ok 1
+ ok 2
+
+congratulations, you've written your first useful test.
+
+
+=head2 Names
+
+That output isn't terribly descriptive, is it? When you have two
+tests you can figure out which one is #2, but what if you have 102?
+
+Each test can be given a little descriptive name as the second
+argument to C<ok()>.
+
+ use Test::Simple tests => 2;
+
+ ok( defined $ical, 'new() returned something' );
+ ok( $ical->isa('Date::ICal'), " and it's the right class" );
+
+So now you'd see...
+
+ 1..2
+ ok 1 - new() returned something
+ ok 2 - and it's the right class
+
+
+=head2 Test the manual
+
+Simplest way to build up a decent testing suite is to just test what
+the manual says it does. [3] Let's pull something out of the
+L<Date::ICal/SYNOPSIS> and test that all its bits work.
+
+ #!/usr/bin/perl -w
+
+ use Test::Simple tests => 8;
+
+ use Date::ICal;
+
+ $ical = Date::ICal->new( year => 1964, month => 10, day => 16,
+ hour => 16, min => 12, sec => 47,
+ tz => '0530' );
+
+ ok( defined $ical, 'new() returned something' );
+ ok( $ical->isa('Date::ICal'), " and it's the right class" );
+ ok( $ical->sec == 47, ' sec()' );
+ ok( $ical->min == 12, ' min()' );
+ ok( $ical->hour == 16, ' hour()' );
+ ok( $ical->day == 17, ' day()' );
+ ok( $ical->month == 10, ' month()' );
+ ok( $ical->year == 1964, ' year()' );
+
+run that and you get:
+
+ 1..8
+ ok 1 - new() returned something
+ ok 2 - and it's the right class
+ ok 3 - sec()
+ ok 4 - min()
+ ok 5 - hour()
+ not ok 6 - day()
+ # Failed test (- at line 16)
+ ok 7 - month()
+ ok 8 - year()
+ # Looks like you failed 1 tests of 8.
+
+Whoops, a failure! [4] Test::Simple helpfully lets us know on what line
+the failure occured, but not much else. We were supposed to get 17,
+but we didn't. What did we get?? Dunno. We'll have to re-run the
+test in the debugger or throw in some print statements to find out.
+
+Instead, we'll switch from B<Test::Simple> to B<Test::More>. B<Test::More>
+does everything B<Test::Simple> does, and more! In fact, Test::More does
+things I<exactly> the way Test::Simple does. You can literally swap
+Test::Simple out and put Test::More in its place. That's just what
+we're going to do.
+
+Test::More does more than Test::Simple. The most important difference
+at this point is it provides more informative ways to say "ok".
+Although you can write almost any test with a generic C<ok()>, it
+can't tell you what went wrong. Instead, we'll use the C<is()>
+function, which lets us declare that something is supposed to be the
+same as something else:
+
+ #!/usr/bin/perl -w
+
+ use Test::More tests => 8;
+
+ use Date::ICal;
+
+ $ical = Date::ICal->new( year => 1964, month => 10, day => 16,
+ hour => 16, min => 12, sec => 47,
+ tz => '0530' );
+
+ ok( defined $ical, 'new() returned something' );
+ ok( $ical->isa('Date::ICal'), " and it's the right class" );
+ is( $ical->sec, 47, ' sec()' );
+ is( $ical->min, 12, ' min()' );
+ is( $ical->hour, 16, ' hour()' );
+ is( $ical->day, 17, ' day()' );
+ is( $ical->month, 10, ' month()' );
+ is( $ical->year, 1964, ' year()' );
+
+"Is C<$ical-E<gt>sec> 47?" "Is C<$ical-E<gt>min> 12?" With C<is()> in place,
+you get some more information
+
+ 1..8
+ ok 1 - new() returned something
+ ok 2 - and it's the right class
+ ok 3 - sec()
+ ok 4 - min()
+ ok 5 - hour()
+ not ok 6 - day()
+ # Failed test (- at line 16)
+ # got: '16'
+ # expected: '17'
+ ok 7 - month()
+ ok 8 - year()
+ # Looks like you failed 1 tests of 8.
+
+letting us know that C<$ical-E<gt>day> returned 16, but we expected 17. A
+quick check shows that the code is working fine, we made a mistake
+when writing up the tests. Just change it to:
+
+ is( $ical->day, 16, ' day()' );
+
+and everything works.
+
+So any time you're doing a "this equals that" sort of test, use C<is()>.
+It even works on arrays. The test is always in scalar context, so you
+can test how many elements are in a list this way. [5]
+
+ is( @foo, 5, 'foo has 5 elements' );
+
+
+=head2 Sometimes the tests are wrong
+
+Which brings us to a very important lesson. Code has bugs. Tests are
+code. Ergo, tests have bugs. A failing test could mean a bug in the
+code, but don't discount the possibility that the test is wrong.
+
+On the flip side, don't be tempted to prematurely declare a test
+incorrect just because you're having trouble finding the bug.
+Invalidating a test isn't something to be taken lightly, and don't use
+it as a cop out to avoid work.
+
+
+=head2 Testing lots of values
+
+We're going to be wanting to test a lot of dates here, trying to trick
+the code with lots of different edge cases. Does it work before 1970?
+After 2038? Before 1904? Do years after 10,000 give it trouble?
+Does it get leap years right? We could keep repeating the code above,
+or we could set up a little try/expect loop.
+
+ use Test::More tests => 32;
+ use Date::ICal;
+
+ my %ICal_Dates = (
+ # An ICal string And the year, month, date
+ # hour, minute and second we expect.
+ '19971024T120000' => # from the docs.
+ [ 1997, 10, 24, 12, 0, 0 ],
+ '20390123T232832' => # after the Unix epoch
+ [ 2039, 1, 23, 23, 28, 32 ],
+ '19671225T000000' => # before the Unix epoch
+ [ 1967, 12, 25, 0, 0, 0 ],
+ '18990505T232323' => # before the MacOS epoch
+ [ 1899, 5, 5, 23, 23, 23 ],
+ );
+
+
+ while( my($ical_str, $expect) = each %ICal_Dates ) {
+ my $ical = Date::ICal->new( ical => $ical_str );
+
+ ok( defined $ical, "new(ical => '$ical_str')" );
+ ok( $ical->isa('Date::ICal'), " and it's the right class" );
+
+ is( $ical->year, $expect->[0], ' year()' );
+ is( $ical->month, $expect->[1], ' month()' );
+ is( $ical->day, $expect->[2], ' day()' );
+ is( $ical->hour, $expect->[3], ' hour()' );
+ is( $ical->min, $expect->[4], ' min()' );
+ is( $ical->sec, $expect->[5], ' sec()' );
+ }
+
+So now we can test bunches of dates by just adding them to
+C<%ICal_Dates>. Now that it's less work to test with more dates, you'll
+be inclined to just throw more in as you think of them.
+Only problem is, every time we add to that we have to keep adjusting
+the C<use Test::More tests =E<gt> ##> line. That can rapidly get
+annoying. There's two ways to make this work better.
+
+First, we can calculate the plan dynamically using the C<plan()>
+function.
+
+ use Test::More;
+ use Date::ICal;
+
+ my %ICal_Dates = (
+ ...same as before...
+ );
+
+ # For each key in the hash we're running 8 tests.
+ plan tests => keys %ICal_Dates * 8;
+
+Or to be even more flexible, we use C<no_plan>. This means we're just
+running some tests, don't know how many. [6]
+
+ use Test::More 'no_plan'; # instead of tests => 32
+
+now we can just add tests and not have to do all sorts of math to
+figure out how many we're running.
+
+
+=head2 Informative names
+
+Take a look at this line here
+
+ ok( defined $ical, "new(ical => '$ical_str')" );
+
+we've added more detail about what we're testing and the ICal string
+itself we're trying out to the name. So you get results like:
+
+ ok 25 - new(ical => '19971024T120000')
+ ok 26 - and it's the right class
+ ok 27 - year()
+ ok 28 - month()
+ ok 29 - day()
+ ok 30 - hour()
+ ok 31 - min()
+ ok 32 - sec()
+
+if something in there fails, you'll know which one it was and that
+will make tracking down the problem easier. So try to put a bit of
+debugging information into the test names.
+
+Describe what the tests test, to make debugging a failed test easier
+for you or for the next person who runs your test.
+
+
+=head2 Skipping tests
+
+Poking around in the existing Date::ICal tests, I found this in
+F<t/01sanity.t> [7]
+
+ #!/usr/bin/perl -w
+
+ use Test::More tests => 7;
+ use Date::ICal;
+
+ # Make sure epoch time is being handled sanely.
+ my $t1 = Date::ICal->new( epoch => 0 );
+ is( $t1->epoch, 0, "Epoch time of 0" );
+
+ # XXX This will only work on unix systems.
+ is( $t1->ical, '19700101Z', " epoch to ical" );
+
+ is( $t1->year, 1970, " year()" );
+ is( $t1->month, 1, " month()" );
+ is( $t1->day, 1, " day()" );
+
+ # like the tests above, but starting with ical instead of epoch
+ my $t2 = Date::ICal->new( ical => '19700101Z' );
+ is( $t2->ical, '19700101Z', "Start of epoch in ICal notation" );
+
+ is( $t2->epoch, 0, " and back to ICal" );
+
+The beginning of the epoch is different on most non-Unix operating
+systems [8]. Even though Perl smooths out the differences for the most
+part, certain ports do it differently. MacPerl is one off the top of
+my head. [9] We I<know> this will never work on MacOS. So rather than
+just putting a comment in the test, we can explicitly say it's never
+going to work and skip the test.
+
+ use Test::More tests => 7;
+ use Date::ICal;
+
+ # Make sure epoch time is being handled sanely.
+ my $t1 = Date::ICal->new( epoch => 0 );
+ is( $t1->epoch, 0, "Epoch time of 0" );
+
+ SKIP: {
+ skip('epoch to ICal not working on MacOS', 6)
+ if $^O eq 'MacOS';
+
+ is( $t1->ical, '19700101Z', " epoch to ical" );
+
+ is( $t1->year, 1970, " year()" );
+ is( $t1->month, 1, " month()" );
+ is( $t1->day, 1, " day()" );
+
+ # like the tests above, but starting with ical instead of epoch
+ my $t2 = Date::ICal->new( ical => '19700101Z' );
+ is( $t2->ical, '19700101Z', "Start of epoch in ICal notation" );
+
+ is( $t2->epoch, 0, " and back to ICal" );
+ }
+
+A little bit of magic happens here. When running on anything but
+MacOS, all the tests run normally. But when on MacOS, C<skip()> causes
+the entire contents of the SKIP block to be jumped over. It's never
+run. Instead, it prints special output that tells Test::Harness that
+the tests have been skipped.
+
+ 1..7
+ ok 1 - Epoch time of 0
+ ok 2 # skip epoch to ICal not working on MacOS
+ ok 3 # skip epoch to ICal not working on MacOS
+ ok 4 # skip epoch to ICal not working on MacOS
+ ok 5 # skip epoch to ICal not working on MacOS
+ ok 6 # skip epoch to ICal not working on MacOS
+ ok 7 # skip epoch to ICal not working on MacOS
+
+This means your tests won't fail on MacOS. This means less emails
+from MacPerl users telling you about failing tests that you know will
+never work. You've got to be careful with skip tests. These are for
+tests which don't work and I<never will>. It is not for skipping
+genuine bugs (we'll get to that in a moment).
+
+The tests are wholly and completely skipped. [10] This will work.
+
+ SKIP: {
+ skip("I don't wanna die!");
+
+ die, die, die, die, die;
+ }
+
+
+=head2 Todo tests
+
+Thumbing through the Date::ICal man page, I came across this:
+
+ ical
+
+ $ical_string = $ical->ical;
+
+ Retrieves, or sets, the date on the object, using any
+ valid ICal date/time string.
+
+"Retrieves or sets". Hmmm, didn't see a test for using C<ical()> to set
+the date in the Date::ICal test suite. So I'll write one.
+
+ use Test::More tests => 1;
+ use Date::ICal;
+
+ my $ical = Date::ICal->new;
+ $ical->ical('20201231Z');
+ is( $ical->ical, '20201231Z', 'Setting via ical()' );
+
+run that and I get
+
+ 1..1
+ not ok 1 - Setting via ical()
+ # Failed test (- at line 6)
+ # got: '20010814T233649Z'
+ # expected: '20201231Z'
+ # Looks like you failed 1 tests of 1.
+
+Whoops! Looks like it's unimplemented. Let's assume we don't have
+the time to fix this. [11] Normally, you'd just comment out the test
+and put a note in a todo list somewhere. Instead, we're going to
+explicitly state "this test will fail" by wrapping it in a C<TODO> block.
+
+ use Test::More tests => 1;
+
+ TODO: {
+ local $TODO = 'ical($ical) not yet implemented';
+
+ my $ical = Date::ICal->new;
+ $ical->ical('20201231Z');
+
+ is( $ical->ical, '20201231Z', 'Setting via ical()' );
+ }
+
+Now when you run, it's a little different:
+
+ 1..1
+ not ok 1 - Setting via ical() # TODO ical($ical) not yet implemented
+ # got: '20010822T201551Z'
+ # expected: '20201231Z'
+
+Test::More doesn't say "Looks like you failed 1 tests of 1". That '#
+TODO' tells Test::Harness "this is supposed to fail" and it treats a
+failure as a successful test. So you can write tests even before
+you've fixed the underlying code.
+
+If a TODO test passes, Test::Harness will report it "UNEXPECTEDLY
+SUCCEEDED". When that happens, you simply remove the TODO block with
+C<local $TODO> and turn it into a real test.
+
+
+=head2 Testing with taint mode.
+
+Taint mode is a funny thing. It's the globalest of all global
+features. Once you turn it on, it affects I<all> code in your program
+and I<all> modules used (and all the modules they use). If a single
+piece of code isn't taint clean, the whole thing explodes. With that
+in mind, it's very important to ensure your module works under taint
+mode.
+
+It's very simple to have your tests run under taint mode. Just throw
+a C<-T> into the C<#!> line. Test::Harness will read the switches
+in C<#!> and use them to run your tests.
+
+ #!/usr/bin/perl -Tw
+
+ ...test normally here...
+
+So when you say C<make test> it will be run with taint mode and
+warnings on.
+
+
+=head1 FOOTNOTES
+
+=over 4
+
+=item 1
+
+The first number doesn't really mean anything, but it has to be 1.
+It's the second number that's important.
+
+=item 2
+
+For those following along at home, I'm using version 1.31. It has
+some bugs, which is good -- we'll uncover them with our tests.
+
+=item 3
+
+You can actually take this one step further and test the manual
+itself. Have a look at B<Test::Inline> (formerly B<Pod::Tests>).
+
+=item 4
+
+Yes, there's a mistake in the test suite. What! Me, contrived?
+
+=item 5
+
+We'll get to testing the contents of lists later.
+
+=item 6
+
+But what happens if your test program dies halfway through?! Since we
+didn't say how many tests we're going to run, how can we know it
+failed? No problem, Test::More employs some magic to catch that death
+and turn the test into a failure, even if every test passed up to that
+point.
+
+=item 7
+
+I cleaned it up a little.
+
+=item 8
+
+Most Operating Systems record time as the number of seconds since a
+certain date. This date is the beginning of the epoch. Unix's starts
+at midnight January 1st, 1970 GMT.
+
+=item 9
+
+MacOS's epoch is midnight January 1st, 1904. VMS's is midnight,
+November 17th, 1858, but vmsperl emulates the Unix epoch so it's not a
+problem.
+
+=item 10
+
+As long as the code inside the SKIP block at least compiles. Please
+don't ask how. No, it's not a filter.
+
+=item 11
+
+Do NOT be tempted to use TODO tests as a way to avoid fixing simple
+bugs!
+
+=back
+
+=head1 AUTHORS
+
+Michael G Schwern E<lt>schwern@pobox.comE<gt> and the perl-qa dancers!
+
+=head1 COPYRIGHT
+
+Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This documentation is free; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+Irrespective of its distribution, all code examples in these files
+are hereby placed into the public domain. You are permitted and
+encouraged to use this code in your own programs for fun
+or for profit as you see fit. A simple comment in the code giving
+credit would be courteous but is not required.
+
+=cut
diff --git a/cpan/dist/PathTools/t/rel2abs2rel.t b/cpan/dist/PathTools/t/rel2abs2rel.t
new file mode 100644
index 00000000..0d684f19
--- /dev/null
+++ b/cpan/dist/PathTools/t/rel2abs2rel.t
@@ -0,0 +1,73 @@
+#!/usr/bin/perl -w
+
+# Here we make sure File::Spec can properly deal with executables.
+# VMS has some trouble with these.
+
+use File::Spec;
+use lib File::Spec->catdir('t', 'lib');
+
+use Test::More (-x $^X
+ ? (tests => 5)
+ : (skip_all => "Can't find an executable file")
+ );
+
+BEGIN { # Set up a tiny script file
+ local *F;
+ open(F, ">rel2abs2rel$$.pl")
+ or die "Can't open rel2abs2rel$$.pl file for script -- $!\n";
+ print F qq(print "ok\\n"\n);
+ close(F);
+}
+END {
+ 1 while unlink("rel2abs2rel$$.pl");
+ 1 while unlink("rel2abs2rel$$.tmp");
+}
+
+use Config;
+
+
+# Change 'perl' to './perl' so the shell doesn't go looking through PATH.
+sub safe_rel {
+ my($perl) = shift;
+ $perl = File::Spec->catfile(File::Spec->curdir, $perl) unless
+ File::Spec->file_name_is_absolute($perl);
+
+ return $perl;
+}
+# Make a putative perl binary say "ok\n". We have to do it this way
+# because the filespec of the binary may contain characters that a
+# command interpreter considers special, so we can't use the obvious
+# `$perl -le "print 'ok'"`. And, for portability, we can't use fork().
+sub sayok{
+ my $perl = shift;
+ open(STDOUTDUP, '>&STDOUT');
+ open(STDOUT, ">rel2abs2rel$$.tmp")
+ or die "Can't open scratch file rel2abs2rel$$.tmp -- $!\n";
+ system($perl, "rel2abs2rel$$.pl");
+ open(STDOUT, '>&STDOUTDUP');
+ close(STDOUTDUP);
+
+ local *F;
+ open(F, "rel2abs2rel$$.tmp");
+ local $/ = undef;
+ my $output = <F>;
+ close(F);
+ return $output;
+}
+
+print "# Checking manipulations of \$^X=$^X\n";
+
+my $perl = safe_rel($^X);
+is( sayok($perl), "ok\n", "'$perl rel2abs2rel$$.pl' works" );
+
+$perl = File::Spec->rel2abs($^X);
+is( sayok($perl), "ok\n", "'$perl rel2abs2rel$$.pl' works" );
+
+$perl = File::Spec->canonpath($perl);
+is( sayok($perl), "ok\n", "canonpath(rel2abs($^X)) = $perl" );
+
+$perl = safe_rel(File::Spec->abs2rel($perl));
+is( sayok($perl), "ok\n", "safe_rel(abs2rel(canonpath(rel2abs($^X)))) = $perl" );
+
+$perl = safe_rel(File::Spec->canonpath($^X));
+is( sayok($perl), "ok\n", "safe_rel(canonpath($^X)) = $perl" );
diff --git a/cpan/dist/PathTools/t/rel2abs_vs_symlink.t b/cpan/dist/PathTools/t/rel2abs_vs_symlink.t
new file mode 100644
index 00000000..556cff2d
--- /dev/null
+++ b/cpan/dist/PathTools/t/rel2abs_vs_symlink.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl -w
+
+# Test that rel2abs() works correctly when the process is under a symlink
+# See [rt.cpan.org 47637]
+
+use strict;
+
+use File::Path;
+use File::Spec;
+
+# Do this to simulate already being inside a symlinked directory
+# and having $ENV{PWD} set.
+use Cwd qw(chdir);
+
+use Test::More;
+
+plan skip_all => "needs symlink()" if !eval { symlink("", ""); 1 };
+
+plan tests => 1;
+
+my $real_dir = "for_rel2abs_test";
+my $symlink = "link_for_rel2abs_test";
+mkdir $real_dir or die "Can't make $real_dir: $!";
+END { rmtree $real_dir }
+
+symlink $real_dir, $symlink or die "Can't symlink $real_dir => $symlink: $!";
+END { unlink $symlink }
+
+chdir $symlink or die "Can't chdir into $symlink: $!";
+
+TODO: {
+ local $TODO = 'Need to find a way to make cwd work reliably under symlinks"';
+ like( File::Spec->rel2abs("."), qr/$symlink/ );
+}
+
+# So the unlinking works
+chdir "..";
diff --git a/cpan/dist/PathTools/t/taint.t b/cpan/dist/PathTools/t/taint.t
new file mode 100644
index 00000000..48f8c5bc
--- /dev/null
+++ b/cpan/dist/PathTools/t/taint.t
@@ -0,0 +1,53 @@
+#!./perl -Tw
+# Testing Cwd under taint mode.
+
+use strict;
+
+use Cwd;
+chdir 't' unless $ENV{PERL_CORE};
+
+use File::Spec;
+use lib File::Spec->catdir('t', 'lib');
+use Test::More;
+BEGIN {
+ plan(
+ ${^TAINT}
+ ? (tests => 21)
+ : (skip_all => "A perl without taint support")
+ );
+}
+
+use Scalar::Util qw/tainted/;
+
+my @Functions = qw(getcwd cwd fastcwd fastgetcwd
+ abs_path fast_abs_path
+ realpath fast_realpath
+ );
+
+foreach my $func (@Functions) {
+ no strict 'refs';
+ my $cwd;
+ eval { $cwd = &{'Cwd::'.$func} };
+ is( $@, '', "$func() should not explode under taint mode" );
+ ok( tainted($cwd), "its return value should be tainted" );
+}
+
+# Previous versions of Cwd tainted $^O
+is !tainted($^O), 1, "\$^O should not be tainted";
+
+{
+ # [perl #126862] canonpath() loses taint
+ my $tainted = substr($ENV{PATH}, 0, 0);
+ # yes, getcwd()'s result should be tainted, and is tested above
+ # but be sure
+ ok tainted(File::Spec->canonpath($tainted . Cwd::getcwd)),
+ "canonpath() keeps taint on non-empty string";
+ ok tainted(File::Spec->canonpath($tainted)),
+ "canonpath() keeps taint on empty string";
+
+ (Cwd::getcwd() =~ /^(.*)/);
+ my $untainted = $1;
+ ok !tainted($untainted), "make sure our untainted value is untainted";
+ ok !tainted(File::Spec->canonpath($untainted)),
+ "canonpath() doesn't add taint to untainted string";
+}
diff --git a/cpan/dist/PathTools/t/tmpdir.t b/cpan/dist/PathTools/t/tmpdir.t
new file mode 100644
index 00000000..0f03dc55
--- /dev/null
+++ b/cpan/dist/PathTools/t/tmpdir.t
@@ -0,0 +1,53 @@
+use strict;
+use Test::More tests => 8;
+
+# Grab all of the plain routines from File::Spec
+use File::Spec;
+use File::Spec::Win32;
+
+require_ok($_) foreach qw(File::Spec File::Spec::Win32);
+
+
+if ($^O eq 'VMS') {
+ # hack:
+ # Need to cause the %ENV to get populated or you only get the builtins at
+ # first, and then something else can cause the hash to get populated.
+ my %look_env = %ENV;
+}
+my $num_keys = keys %ENV;
+File::Spec->tmpdir;
+is scalar keys %ENV, $num_keys, "tmpdir() shouldn't change the contents of %ENV";
+
+SKIP: {
+ skip("Can't make list assignment to %ENV on this system", 1)
+ if $^O eq 'VMS';
+
+ local %ENV;
+ File::Spec::Win32->tmpdir;
+ is(scalar keys %ENV, 0, "Win32->tmpdir() shouldn't change the contents of %ENV");
+}
+
+File::Spec::Win32->tmpdir;
+is(scalar keys %ENV, $num_keys, "Win32->tmpdir() shouldn't change the contents of %ENV");
+
+# Changing tmpdir dynamically
+for ('File::Spec', "File::Spec::Win32") {
+ SKIP: {
+ skip('sys$scratch: takes precedence over env on vms', 1)
+ if $^O eq 'VMS';
+ local $ENV{TMPDIR} = $_->catfile($_->curdir, 'lib');
+ -d $ENV{TMPDIR} && -w _
+ or skip "Can't create usable TMPDIR env var", 1;
+ my $tmpdir1 = $_->tmpdir;
+ $ENV{TMPDIR} = $_->catfile($_->curdir, 't');
+ -d $ENV{TMPDIR} && -w _
+ or skip "Can't create usable TMPDIR env var", 1;
+ my $tmpdir2 = $_->tmpdir;
+ isn't $tmpdir2, $tmpdir1, "$_->tmpdir works with changing env";
+ }
+}
+
+ok(
+ File::Spec->file_name_is_absolute(File::Spec->tmpdir()),
+ "tmpdir() always returns an absolute path"
+);
diff --git a/cpan/dist/PathTools/t/win32.t b/cpan/dist/PathTools/t/win32.t
new file mode 100644
index 00000000..3fa5cb86
--- /dev/null
+++ b/cpan/dist/PathTools/t/win32.t
@@ -0,0 +1,32 @@
+#!./perl
+
+use File::Spec;
+use lib File::Spec->catdir('t', 'lib');
+use Test::More;
+
+if( $^O eq 'MSWin32' ) {
+ plan tests => 4;
+} else {
+ plan skip_all => 'this is not win32';
+}
+
+use Cwd;
+ok 1;
+
+my $cdir = getdcwd('C:');
+like $cdir, qr{^C:}i;
+
+my $ddir = getdcwd('D:');
+if (defined $ddir) {
+ like $ddir, qr{^D:}i;
+} else {
+ # May not have a D: drive mounted
+ ok 1;
+}
+
+# Ensure compatibility with naughty versions of Template::Toolkit,
+# which pass in a bare $1 as an argument
+'Foo/strawberry' =~ /(.*)/;
+my $result = File::Spec::Win32->catfile('C:/cache', $1);
+is( $result, 'C:\cache\Foo\strawberry' );
+
generated by cgit v1.2.1 (git 2.18.0) at 2026-09-05 09:03:05 +0000