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