From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

EWILHELM / Module-Build-0.2808_02 / t / tilde.t 

            

              
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

              
#!/usr/bin/perl -w
# Test ~ expansion from command line arguments.
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
use MBTest tests => 17;
use_ok 'Module::Build';
ensure_blib('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", 14 if $@;
      $home = $info[7];
    }
    is( run_sample( $p => '~'     )->$p(),  $home );
    is( run_sample( $p => '~/foo' )->$p(),  "$home/foo" );
    is( run_sample( $p => '~~'    )->$p(),  '~~' );
    is( run_sample( $p => '~ foo' )->$p(),  '~ 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 );
    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' );
}
# 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 );
}
# cleanup
$dist->remove;