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

1 files changed, 107 insertions, 0 deletions

diff --git a/dist/PathTools/t/abs2rel.t b/dist/PathTools/t/abs2rel.t
new file mode 100644
index 0000000000..008498d823
--- /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();