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 => 18;
   8
   9 use_ok 'Module::Build';
  10 ensure_blib('Module::Build');
  11
  12 my $tmp = MBTest->tmpdir;
  13
  14 use DistGen;
  15 my $dist = DistGen->new( dir => $tmp );
  16 $dist->regen;
  17
  18 $dist->chdir_in;
  19
  20
  21 sub run_sample {
  22     my @args = @_;
  23
  24     local $Test::Builder::Level = $Test::Builder::Level + 1;
  25
  26     $dist->clean;
  27
  28     my $mb;
  29     stdout_of( sub {
  30       $mb = Module::Build->new_from_context( @args );
  31     } );
  32
  33     return $mb;
  34 }
  35
  36
  37 my $p = 'install_base';
  38
  39 SKIP: {
  40     my $home = $ENV{HOME} ? $ENV{HOME} : undef;
  41
  42     if ($^O eq 'VMS') {
  43         # Convert the path to UNIX format, trim off the trailing slash
  44         $home = VMS::Filespec::unixify($home);
  45         $home =~ s#/$##;
  46     }
  47
  48     unless (defined $home) {
  49       my @info = eval { getpwuid $> };
  50       skip "No home directory for tilde-expansion tests", 15 if $@;
  51       $home = $info[7];
  52     }
  53
  54     is( run_sample( $p => '~'     )->$p(),  $home );
  55
  56     is( run_sample( $p => '~/foo' )->$p(),  "$home/foo" );
  57
  58     is( run_sample( $p => '~~'    )->$p(),  '~~' );
  59
  60     is( run_sample( $p => '~ foo' )->$p(),  '~ foo' );
  61
  62     is( run_sample( $p => '~/ foo')->$p(),  "$home/ foo" );
  63
  64     is( run_sample( $p => '~/fo o')->$p(),  "$home/fo o" );
  65
  66     is( run_sample( $p => 'foo~'  )->$p(),  'foo~' );
  67
  68     is( run_sample( prefix => '~' )->prefix,
  69         $home );
  70
  71     # Test when HOME is different from getpwuid(), as in sudo.
  72     {
  73         local $ENV{HOME} = '/wibble/whomp';
  74
  75         is( run_sample( $p => '~' )->$p(),    "/wibble/whomp" );
  76     }
  77
  78     my $mb = run_sample( install_path => { html => '~/html',
  79                                            lib  => '~/lib'   }
  80                        );
  81     is( $mb->install_destination('lib'),  "$home/lib" );
  82     # 'html' is translated to 'binhtml' & 'libhtml'
  83     is( $mb->install_destination('binhtml'), "$home/html" );
  84     is( $mb->install_destination('libhtml'), "$home/html" );
  85
  86     $mb = run_sample( install_path => { lib => '~/lib' } );
  87     is( $mb->install_destination('lib'),  "$home/lib" );
  88
  89     $mb = run_sample( destdir => '~' );
  90     is( $mb->destdir,           $home );
  91
  92     $mb->$p('~');
  93     is( $mb->$p(),      '~', 'API does not expand tildes' );
  94 }
  95
  96 # Again, with named users
  97 SKIP: {
  98     my @info = eval { getpwuid $> };
  99     skip "No home directory for tilde-expansion tests", 1 if $@;
 100     my ($me, $home) = @info[0,7];
 101
 102     my $expected = "$home/foo";
 103
 104     if ($^O eq 'VMS') {
 105         # Convert the path to UNIX format and trim off the trailing slash
 106         $home = VMS::Filespec::unixify($home);
 107         $home =~ s#/$##;
 108         $expected = $home . '/../[^/]+' . '/foo';
 109     }
 110
 111     like( run_sample( $p => "~$me/foo")->$p(),  qr($expected)i );
 112 }
 113
 114
 115 # cleanup
 116 $dist->remove;