diff options
| author | Ken Williams <ken@mathforum.org> | 2004-03-07 03:37:19 -0600 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2004-03-07 18:41:36 +0000 |
| commit | b86ce628f044c5a1a6c161059427f158d00aee13 (patch) | |
| tree | 9aa0c7af31c714888aa80f4344e5bd7d4b11d346 /ext/Cwd | |
| parent | af6a4ad191050514a1d8dc2a8b03c1c1459c2343 (diff) | |
| download | perl-b86ce628f044c5a1a6c161059427f158d00aee13.tar.gz | |
Re: [PATCH Cwd 2.15] test tweak for VMS
From: "Ken Williams" <ken@mathforum.org>
Message-Id: <51C75B2A-704D-11D8-BBD2-003065F6D85A@mathforum.org>
p4raw-id: //depot/perl@22459
Diffstat (limited to 'ext/Cwd')
| -rw-r--r-- | ext/Cwd/t/cwd.t | 29 |
1 files changed, 22 insertions, 7 deletions
diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t index fbd8133cd9..3644833623 100644 --- a/ext/Cwd/t/cwd.t +++ b/ext/Cwd/t/cwd.t @@ -89,9 +89,8 @@ SKIP: { } } -my $Top_Test_Dir = '_ptrslt_'; -my $Test_Dir = File::Spec->catdir($Top_Test_Dir, qw/_path_ _to_ _a_ _dir_/); -my $want = quotemeta File::Spec->rel2abs($Test_Dir); +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; @@ -99,11 +98,11 @@ Cwd::chdir $Test_Dir; foreach my $func (qw(cwd getcwd fastcwd fastgetcwd)) { my $result = eval "$func()"; is $@, ''; - like( File::Spec->canonpath($result), qr|$want$|i, "$func()" ); + dir_ends_with( $result, $Test_Dir, "$func()" ); } # Cwd::chdir should also update $ENV{PWD} -like(File::Spec->canonpath($ENV{PWD}), qr|$want$|i, 'Cwd::chdir() updates $ENV{PWD}'); +dir_ends_with( $ENV{PWD}, $Test_Dir, 'Cwd::chdir() updates $ENV{PWD}' ); my $updir = File::Spec->updir; Cwd::chdir $updir; print "#$ENV{PWD}\n"; @@ -116,7 +115,7 @@ print "#$ENV{PWD}\n"; Cwd::chdir $updir; print "#$ENV{PWD}\n"; -rmtree([$Top_Test_Dir], 0, 0); +rmtree($test_dirs[0], 0, 0); { my $check = ($IsVMS ? qr|\b((?i)t)\]$| : @@ -139,6 +138,22 @@ SKIP: { like($abs_path, qr|$want$|); like($fast_abs_path, qr|$want$|); - rmtree([$Top_Test_Dir], 0, 0); + rmtree($test_dirs[0], 0, 0); unlink "linktest"; } + +############################################# +# These two routines give us sort of a poor-man's cross-platform +# directory comparison routine. + +sub bracketed_form { + 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($expect); + like( bracketed_form($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) ); +} + |