diff options
Diffstat (limited to 't/tilde.t')
-rw-r--r-- | t/tilde.t | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/t/tilde.t b/t/tilde.t new file mode 100644 index 0000000..09673f6 --- /dev/null +++ b/t/tilde.t @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +# Test ~ expansion from command line arguments. + +use strict; +use lib 't/lib'; +use MBTest tests => 16; + +blib_load('Module::Build'); + +my $tmp = MBTest->tmpdir; + +use DistGen; +my $dist = DistGen->new( dir => $tmp ); +$dist->regen; + +$dist->chdir_in; + + +sub run_sample { + my @args = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + $dist->clean; + + my $mb; + stdout_of( sub { + $mb = Module::Build->new_from_context( @args ); + } ); + + return $mb; +} + + +my $p = 'install_base'; + +SKIP: { + my $home = $ENV{HOME} ? $ENV{HOME} : undef; + + if ($^O eq 'VMS') { + # Convert the path to UNIX format, trim off the trailing slash + $home = VMS::Filespec::unixify($home); + $home =~ s#/$##; + } + + unless (defined $home) { + my @info = eval { getpwuid $> }; + skip "No home directory for tilde-expansion tests", 15 if $@ + or !defined $info[7]; + $home = $info[7]; + } + + is( run_sample( $p => '~' )->$p(), $home ); + + is( run_sample( $p => '~/fooxzy' )->$p(), "$home/fooxzy" ); + + is( run_sample( $p => '~/ fooxzy')->$p(), "$home/ fooxzy" ); + + is( run_sample( $p => '~/fo o')->$p(), "$home/fo o" ); + + is( run_sample( $p => 'fooxzy~' )->$p(), 'fooxzy~' ); + + is( run_sample( prefix => '~' )->prefix, + $home ); + + # Test when HOME is different from getpwuid(), as in sudo. + { + local $ENV{HOME} = '/wibble/whomp'; + + is( run_sample( $p => '~' )->$p(), "/wibble/whomp" ); + } + + my $mb = run_sample( install_path => { html => '~/html', + lib => '~/lib' } + ); + is( $mb->install_destination('lib'), "$home/lib" ); + # 'html' is translated to 'binhtml' & 'libhtml' + is( $mb->install_destination('binhtml'), "$home/html" ); + is( $mb->install_destination('libhtml'), "$home/html" ); + + $mb = run_sample( install_path => { lib => '~/lib' } ); + is( $mb->install_destination('lib'), "$home/lib" ); + + $mb = run_sample( destdir => '~' ); + is( $mb->destdir, $home ); + + $mb->$p('~'); + is( $mb->$p(), '~', 'API does not expand tildes' ); + + skip "On OS/2 EMX all users are equal", 2 if $^O eq 'os2'; + is( run_sample( $p => '~~' )->$p(), '~~' ); + is( run_sample( $p => '~ fooxzy' )->$p(), '~ fooxzy' ); +} + +# Again, with named users +SKIP: { + my @info = eval { getpwuid $> }; + skip "No home directory for tilde-expansion tests", 1 if $@ + or !defined $info[7] or !defined $info[0]; + my ($me, $home) = @info[0,7]; + + if ($^O eq 'VMS') { + # Convert the path to UNIX format and trim off the trailing slash. + # Also, the fake module we're in has mangled $ENV{HOME} for its own + # purposes; getpwuid doesn't know about that but _detildefy does. + $home = VMS::Filespec::unixify($ENV{HOME}); + $home =~ s#/$##; + } + my $expected = "$home/fooxzy"; + + like( run_sample( $p => "~$me/fooxzy")->$p(), qr(\Q$expected\E)i ); +} + |