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