1N/A#!/usr/bin/perl -w
1N/A
1N/A# Here we make sure File::Spec can properly deal with executables.
1N/A# VMS has some trouble with these.
1N/A
1N/Ause Test::More (-x $^X
1N/A ? (tests => 5)
1N/A : (skip_all => "Can't find an executable file")
1N/A );
1N/A
1N/ABEGIN { # Set up a tiny script file
1N/A local *F;
1N/A open(F, ">rel2abs2rel$$.pl")
1N/A or die "Can't open rel2abs2rel$$.pl file for script -- $!\n";
1N/A print F qq(print "ok\\n"\n);
1N/A close(F);
1N/A}
1N/AEND {
1N/A 1 while unlink("rel2abs2rel$$.pl");
1N/A 1 while unlink("rel2abs2rel$$.tmp");
1N/A}
1N/A
1N/Ause Config;
1N/A
1N/Ause File::Spec;
1N/A
1N/A# Change 'perl' to './perl' so the shell doesn't go looking through PATH.
1N/Asub safe_rel {
1N/A my($perl) = shift;
1N/A $perl = File::Spec->catfile(File::Spec->curdir, $perl) unless
1N/A File::Spec->file_name_is_absolute($perl);
1N/A
1N/A return $perl;
1N/A}
1N/A# Make a putative perl binary say "ok\n". We have to do it this way
1N/A# because the filespec of the binary may contain characters that a
1N/A# command interpreter considers special, so we can't use the obvious
1N/A# `$perl -le "print 'ok'"`. And, for portability, we can't use fork().
1N/Asub sayok{
1N/A my $perl = shift;
1N/A open(STDOUTDUP, '>&STDOUT');
1N/A open(STDOUT, ">rel2abs2rel$$.tmp")
1N/A or die "Can't open scratch file rel2abs2rel$$.tmp -- $!\n";
1N/A system($perl, "rel2abs2rel$$.pl");
1N/A open(STDOUT, '>&STDOUTDUP');
1N/A close(STDOUTDUP);
1N/A
1N/A local *F;
1N/A open(F, "rel2abs2rel$$.tmp");
1N/A local $/ = undef;
1N/A my $output = <F>;
1N/A close(F);
1N/A return $output;
1N/A}
1N/A
1N/Aprint "# Checking manipulations of \$^X=$^X\n";
1N/A
1N/Amy $perl = safe_rel($^X);
1N/Ais( sayok($perl), "ok\n", "`$perl rel2abs2rel$$.pl` works" );
1N/A
1N/A$perl = File::Spec->rel2abs($^X);
1N/Ais( sayok($perl), "ok\n", "`$perl rel2abs2rel$$.pl` works" );
1N/A
1N/A$perl = File::Spec->canonpath($perl);
1N/Ais( sayok($perl), "ok\n", "canonpath(rel2abs($^X)) = $perl" );
1N/A
1N/A$perl = safe_rel(File::Spec->abs2rel($perl));
1N/Ais( sayok($perl), "ok\n", "safe_rel(abs2rel(canonpath(rel2abs($^X)))) = $perl" );
1N/A
1N/A$perl = safe_rel(File::Spec->canonpath($^X));
1N/Ais( sayok($perl), "ok\n", "safe_rel(canonpath($^X)) = $perl" );