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'; |
7253302f |
7 | use MBTest tests => 10; |
bb4e9162 |
8 | |
9 | use Cwd (); |
10 | my $cwd = Cwd::cwd; |
11 | my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' ); |
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 | |
38 | { |
39 | local $ENV{HOME} = 'home'; |
40 | |
41 | my $mb; |
42 | |
43 | $mb = run_sample( install_base => '~' ); |
44 | is( $mb->install_base, $ENV{HOME} ); |
45 | |
46 | $mb = run_sample( install_base => '~/foo' ); |
47 | is( $mb->install_base, "$ENV{HOME}/foo" ); |
48 | |
bb4e9162 |
49 | $mb = run_sample( install_base => 'foo~' ); |
50 | is( $mb->install_base, 'foo~' ); |
51 | |
52 | $mb = run_sample( prefix => '~' ); |
53 | is( $mb->prefix, $ENV{HOME} ); |
54 | |
55 | $mb = run_sample( install_path => { html => '~/html', |
56 | lib => '~/lib' } |
57 | ); |
58 | is( $mb->install_destination('lib'), "$ENV{HOME}/lib" ); |
59 | # 'html' is translated to 'binhtml' & 'libhtml' |
60 | is( $mb->install_destination('binhtml'), "$ENV{HOME}/html" ); |
61 | is( $mb->install_destination('libhtml'), "$ENV{HOME}/html" ); |
62 | |
63 | $mb = run_sample( install_path => { lib => '~/lib' } ); |
64 | is( $mb->install_destination('lib'), "$ENV{HOME}/lib" ); |
65 | |
66 | $mb = run_sample( destdir => '~' ); |
67 | is( $mb->destdir, $ENV{HOME} ); |
68 | |
69 | $mb->install_base('~'); |
70 | is( $mb->install_base, '~', 'API does not expand tildes' ); |
71 | } |
72 | |
73 | |
74 | # cleanup |
75 | chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; |
76 | $dist->remove; |
77 | |
78 | use File::Path; |
79 | rmtree( $tmp ); |