1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
#!/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 $@;
$home = $info[7];
}
is( run_sample( $p => '~' )->$p(), $home );
is( run_sample( $p => '~/foo' )->$p(), "$home/foo" );
is( run_sample( $p => '~/ foo')->$p(), "$home/ foo" );
is( run_sample( $p => '~/fo o')->$p(), "$home/fo o" );
is( run_sample( $p => 'foo~' )->$p(), 'foo~' );
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 => '~ foo' )->$p(), '~ foo' );
}
# Again, with named users
SKIP: {
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 1 if $@;
my ($me, $home) = @info[0,7];
my $expected = "$home/foo";
if ($^O eq 'VMS') {
# Convert the path to UNIX format and trim off the trailing slash
$home = VMS::Filespec::unixify($home);
$home =~ s#/$##;
$expected = $home . '/../[^/]+' . '/foo';
}
like( run_sample( $p => "~$me/foo")->$p(), qr($expected)i );
}
|
