lib/File/Spec/t/rel2abs2rel.t

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