lib/Module/Build/t/tilde.t

   1 #!/usr/bin/perl -w
   2
   3 # Test ~ expansion from command line arguments.
   4
   5 use strict;
   6 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
   7 use MBTest tests => 15;
   8
   9 use Cwd ();
  10 my $cwd = Cwd::cwd;
  11 my $tmp = MBTest->tmpdir;
  12
  13 use DistGen;
  14 my $dist = DistGen->new( dir => $tmp );
  15 $dist->regen;
  16
  17 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
  18
  19
  20 use Module::Build;
  21
  22 sub run_sample {
  23     my @args = @_;
  24
  25     local $Test::Builder::Level = $Test::Builder::Level + 1;
  26
  27     $dist->clean;
  28
  29     my $mb;
  30     stdout_of( sub {
  31       $mb = Module::Build->new_from_context( @args );
  32     } );
  33
  34     return $mb;
  35 }
  36
  37
  38 my $p = 'install_base';
  39
  40 SKIP: {
  41     my $home = $ENV{HOME} ? $ENV{HOME} : undef;
  42     skip "Needs case and syntax tweaks for VMS", 14 if $^O eq 'VMS';
  43     unless (defined $home) {
  44       my @info = eval { getpwuid $> };
  45       skip "No home directory for tilde-expansion tests", 14 if $@;
  46       $home = $info[7];
  47     }
  48
  49     is( run_sample( $p => '~'     )->$p(),  $home );
  50
  51     is( run_sample( $p => '~/foo' )->$p(),  "$home/foo" );
  52
  53     is( run_sample( $p => '~~'    )->$p(),  '~~' );
  54
  55     is( run_sample( $p => '~ foo' )->$p(),  '~ foo' );
  56
  57     is( run_sample( $p => '~/ foo')->$p(),  "$home/ foo" );
  58
  59     is( run_sample( $p => '~/fo o')->$p(),  "$home/fo o" );
  60
  61     is( run_sample( $p => 'foo~'  )->$p(),  'foo~' );
  62
  63     is( run_sample( prefix => '~' )->prefix,
  64         $home );
  65
  66     my $mb = run_sample( install_path => { html => '~/html',
  67                                            lib  => '~/lib'   }
  68                        );
  69     is( $mb->install_destination('lib'),  "$home/lib" );
  70     # 'html' is translated to 'binhtml' & 'libhtml'
  71     is( $mb->install_destination('binhtml'), "$home/html" );
  72     is( $mb->install_destination('libhtml'), "$home/html" );
  73
  74     $mb = run_sample( install_path => { lib => '~/lib' } );
  75     is( $mb->install_destination('lib'),  "$home/lib" );
  76
  77     $mb = run_sample( destdir => '~' );
  78     is( $mb->destdir,           $home );
  79
  80     $mb->$p('~');
  81     is( $mb->$p(),      '~', 'API does not expand tildes' );
  82 }
  83
  84 # Again, with named users
  85 SKIP: {
  86     skip "Needs case and syntax tweaks for VMS", 1 if $^O eq 'VMS';
  87     my @info = eval { getpwuid $> };
  88     skip "No home directory for tilde-expansion tests", 1 if $@;
  89     my ($me, $home) = @info[0,7];
  90
  91     is( run_sample( $p => "~$me/foo")->$p(),  "$home/foo" );
  92 }
  93
  94
  95 # cleanup
  96 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
  97 $dist->remove;
  98
  99 use File::Path;
 100 rmtree( $tmp );