ext/Cwd/t/rel2abs2rel.t

   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
   6 use File::Spec;
   7 use lib File::Spec->catdir('t', 'lib');
   8
   9 use Test::More (-x $^X
  10                 ? (tests => 5)
  11                 : (skip_all => "Can't find an executable file")
  12                );
  13
  14 BEGIN {                                # 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 }
  21 END {
  22     1 while unlink("rel2abs2rel$$.pl");
  23     1 while unlink("rel2abs2rel$$.tmp");
  24 }
  25
  26 use Config;
  27
  28
  29 # Change 'perl' to './perl' so the shell doesn't go looking through PATH.
  30 sub 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().
  41 sub 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
  58 print "# Checking manipulations of \$^X=$^X\n";
  59
  60 my $perl = safe_rel($^X);
  61 is( sayok($perl), "ok\n",   "`$perl rel2abs2rel$$.pl` works" );
  62
  63 $perl = File::Spec->rel2abs($^X);
  64 is( sayok($perl), "ok\n",   "`$perl rel2abs2rel$$.pl` works" );
  65
  66 $perl = File::Spec->canonpath($perl);
  67 is( sayok($perl), "ok\n",   "canonpath(rel2abs($^X)) = $perl" );
  68
  69 $perl = safe_rel(File::Spec->abs2rel($perl));
  70 is( sayok($perl), "ok\n",   "safe_rel(abs2rel(canonpath(rel2abs($^X)))) = $perl" );
  71
  72 $perl = safe_rel(File::Spec->canonpath($^X));
  73 is( sayok($perl), "ok\n",   "safe_rel(canonpath($^X)) = $perl" );