In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ec9e47ebf20db99adb00e868eff8a50a70b15b71?hp=e660c409f22c1a7f1be06f3ef5168a7a09a5835a>
- Log ----------------------------------------------------------------- commit ec9e47ebf20db99adb00e868eff8a50a70b15b71 Author: James E Keenan <[email protected]> Date: Tue Oct 21 19:29:33 2014 -0400 Demonstrate that RT #121360 has been resolved. Bug report filed by James Avera argued that "File::Spec->abs2rel($path, $base) is supposed to allow $path and/or $base to be relative to the current working directory, and the pod says that if either are relative, they are converted to absolute using 'rel2abs()'." The cases reported as failing were subsequently reported as passing. Adding a test file to confirm this. TODO: Adapt test for VMS. For: RT #121360 ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + dist/PathTools/t/abs2rel.t | 107 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 108 insertions(+) create mode 100644 dist/PathTools/t/abs2rel.t diff --git a/MANIFEST b/MANIFEST index 50bfc6f..3f188a9 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3305,6 +3305,7 @@ dist/PathTools/lib/File/Spec/Unix.pm portable operations on Unix file names dist/PathTools/lib/File/Spec/VMS.pm portable operations on VMS file names dist/PathTools/lib/File/Spec/Win32.pm portable operations on Win32 and NetWare file names dist/PathTools/Makefile.PL makefile writer for Cwd +dist/PathTools/t/abs2rel.t See if File::Spec->abs2rel works dist/PathTools/t/crossplatform.t See if File::Spec works crossplatform dist/PathTools/t/cwd.t See if Cwd works dist/PathTools/t/Functions.t See if File::Spec::Functions works diff --git a/dist/PathTools/t/abs2rel.t b/dist/PathTools/t/abs2rel.t new file mode 100644 index 0000000..008498d --- /dev/null +++ b/dist/PathTools/t/abs2rel.t @@ -0,0 +1,107 @@ +#!/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(); + +test_rel2abs( { + startdir => $startdir, + first_sub_dir => 'etc', + sub_sub_dir => 'init.d', + first_file => 'passwd', + second_sub_dir => 'dev', + second_file => 'null', +} ); + +test_rel2abs( { + startdir => $startdir, + first_sub_dir => 'etc', + sub_sub_dir => 'init.d', + first_file => './passwd', + second_sub_dir => 'dev', + second_file => 'null', +} ); + +test_rel2abs( { + startdir => $startdir, + first_sub_dir => 'etc', + sub_sub_dir => 'init.d', + first_file => '../etc/passwd', + second_sub_dir => 'dev', + second_file => 'null', +} ); + +test_rel2abs( { + startdir => $startdir, + first_sub_dir => 'etc', + sub_sub_dir => 'init.d', + first_file => '../dev/null', + second_sub_dir => 'dev', + second_file => 'null', +} ); + +sub test_rel2abs { + my $args = shift; + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or die "Unable to change to $tdir: $!"; + + my @subdirs = ( + $args->{first_sub_dir}, + File::Spec->catdir($args->{first_sub_dir}, $args->{sub_sub_dir}), + $args->{second_sub_dir} + ); + make_path(@subdirs, { mode => 0711 }) + or die "Unable to make_path: $!"; + + open my $OUT2, '>', + File::Spec->catfile($args->{second_sub_dir}, $args->{second_file}) + or die "Unable to open $args->{second_file} for writing: $!"; + print $OUT2 "Attempting to resolve RT #121360\n"; + close $OUT2 or die "Unable to close $args->{second_file} after writing: $!"; + + chdir $args->{first_sub_dir} + or die "Unable to change to '$args->{first_sub_dir}': $!"; + open my $OUT1, '>', $args->{first_file} + or die "Unable to open $args->{first_file} for writing: $!"; + print $OUT1 "Attempting to resolve RT #121360\n"; + close $OUT1 or die "Unable to close $args->{first_file} after writing: $!"; + + my $rel_path = $args->{first_file}; + my $rel_base = $args->{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 $args->{startdir} or die "Unable to change back to $args->{startdir}: $!"; +} + +done_testing(); -- Perl5 Master Repository
