1#!/usr/bin/perl -w
2
3# Here we make sure File::Spec can properly deal with executables.
4# VMS has some trouble with these.
5
6use File::Spec;
7use lib File::Spec->catdir('t', 'lib');
8
9use Test::More (-x $^X
10		? (tests => 5)
11		: (skip_all => "Can't find an executable file")
12	       );
13
14BEGIN {                                # Set up a tiny script file
15    local *F;
16    open(F, ">rel2abs2rel$$.pl")
17      or die "Can't open rel2abs2rel$$.pl file for script -- $!\n";
18    print F qq(print "ok\\n"\n);
19    close(F);
20}
21END {
22    1 while unlink("rel2abs2rel$$.pl");
23    1 while unlink("rel2abs2rel$$.tmp");
24}
25
26use Config;
27
28
29# Change 'perl' to './perl' so the shell doesn't go looking through PATH.
30sub safe_rel {
31    my($perl) = shift;
32    $perl = File::Spec->catfile(File::Spec->curdir, $perl) unless
33      File::Spec->file_name_is_absolute($perl);
34
35    return $perl;
36}
37# Make a putative perl binary say "ok\n". We have to do it this way
38# because the filespec of the binary may contain characters that a
39# command interpreter considers special, so we can't use the obvious
40# `$perl -le "print 'ok'"`. And, for portability, we can't use fork().
41sub sayok{
42    my $perl = shift;
43    open(STDOUTDUP, '>&STDOUT');
44    open(STDOUT, ">rel2abs2rel$$.tmp")
45        or die "Can't open scratch file rel2abs2rel$$.tmp -- $!\n";
46    system($perl, "rel2abs2rel$$.pl");
47    open(STDOUT, '>&STDOUTDUP');
48    close(STDOUTDUP);
49
50    local *F;
51    open(F, "rel2abs2rel$$.tmp");
52    local $/ = undef;
53    my $output = <F>;
54    close(F);
55    return $output;
56}
57
58print "# Checking manipulations of \$^X=$^X\n";
59
60my $perl = safe_rel($^X);
61is( sayok($perl), "ok\n",   "'$perl rel2abs2rel$$.pl' works" );
62
63$perl = File::Spec->rel2abs($^X);
64is( sayok($perl), "ok\n",   "'$perl rel2abs2rel$$.pl' works" );
65
66$perl = File::Spec->canonpath($perl);
67is( sayok($perl), "ok\n",   "canonpath(rel2abs($^X)) = $perl" );
68
69$perl = safe_rel(File::Spec->abs2rel($perl));
70is( sayok($perl), "ok\n",   "safe_rel(abs2rel(canonpath(rel2abs($^X)))) = $perl" );
71
72$perl = safe_rel(File::Spec->canonpath($^X));
73is( sayok($perl), "ok\n",   "safe_rel(canonpath($^X)) = $perl" );
74