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