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