Commit | Line | Data |
bb4e9162 |
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'; |
7a827510 |
7 | use MBTest tests => 15; |
bb4e9162 |
8 | |
9 | use Cwd (); |
10 | my $cwd = Cwd::cwd; |
7a827510 |
11 | my $tmp = MBTest->tmpdir; |
bb4e9162 |
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 | |
7a827510 |
38 | my $p = 'install_base'; |
bb4e9162 |
39 | |
7a827510 |
40 | SKIP: { |
41 | my $home = $ENV{HOME} ? $ENV{HOME} : undef; |
42 | unless (defined $home) { |
43 | my @info = eval { getpwuid $> }; |
44 | skip "No home directory for tilde-expansion tests", 14 if $@; |
45 | $home = $info[7]; |
46 | } |
bb4e9162 |
47 | |
7a827510 |
48 | is( run_sample( $p => '~' )->$p(), $home ); |
c1d8f74e |
49 | |
7a827510 |
50 | is( run_sample( $p => '~/foo' )->$p(), "$home/foo" ); |
c1d8f74e |
51 | |
7a827510 |
52 | is( run_sample( $p => '~~' )->$p(), '~~' ); |
c1d8f74e |
53 | |
7a827510 |
54 | is( run_sample( $p => '~ foo' )->$p(), '~ foo' ); |
c1d8f74e |
55 | |
7a827510 |
56 | is( run_sample( $p => '~/ foo')->$p(), "$home/ foo" ); |
57 | |
58 | is( run_sample( $p => '~/fo o')->$p(), "$home/fo o" ); |
c1d8f74e |
59 | |
7a827510 |
60 | is( run_sample( $p => 'foo~' )->$p(), 'foo~' ); |
bb4e9162 |
61 | |
7a827510 |
62 | is( run_sample( prefix => '~' )->prefix, |
63 | $home ); |
bb4e9162 |
64 | |
7a827510 |
65 | my $mb = run_sample( install_path => { html => '~/html', |
66 | lib => '~/lib' } |
67 | ); |
68 | is( $mb->install_destination('lib'), "$home/lib" ); |
bb4e9162 |
69 | # 'html' is translated to 'binhtml' & 'libhtml' |
7a827510 |
70 | is( $mb->install_destination('binhtml'), "$home/html" ); |
71 | is( $mb->install_destination('libhtml'), "$home/html" ); |
bb4e9162 |
72 | |
73 | $mb = run_sample( install_path => { lib => '~/lib' } ); |
7a827510 |
74 | is( $mb->install_destination('lib'), "$home/lib" ); |
bb4e9162 |
75 | |
76 | $mb = run_sample( destdir => '~' ); |
7a827510 |
77 | is( $mb->destdir, $home ); |
78 | |
79 | $mb->$p('~'); |
80 | is( $mb->$p(), '~', 'API does not expand tildes' ); |
81 | } |
bb4e9162 |
82 | |
7a827510 |
83 | # Again, with named users |
84 | SKIP: { |
85 | my @info = eval { getpwuid $> }; |
86 | skip "No home directory for tilde-expansion tests", 1 if $@; |
87 | my ($me, $home) = @info[0,7]; |
88 | |
89 | is( run_sample( $p => "~$me/foo")->$p(), "$home/foo" ); |
bb4e9162 |
90 | } |
91 | |
92 | |
93 | # cleanup |
94 | chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; |
95 | $dist->remove; |
96 | |
97 | use File::Path; |
98 | rmtree( $tmp ); |