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
|
#!/usr/bin/perl -w
# Test ~ expansion from command line arguments.
use strict;
use lib 't/lib';
use Test::More tests => 9;
use ExtUtils::Helpers 'detildefy';
SKIP: {
my $env_name = $^O eq 'MSWin32' ? 'USERPROFILE' : 'HOME';
my $home = $ENV{$env_name};
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", 8 if $@ or !defined $info[7];
$home = $info[7];
}
is( detildefy('~'), $home);
is( detildefy('~/fooxzy'), "$home/fooxzy");
is( detildefy('~/ fooxzy'), "$home/ fooxzy");
is( detildefy('~/fo o'), "$home/fo o");
is( detildefy('fooxzy~'), 'fooxzy~');
# Test when HOME is different from getpwuid(), as in sudo.
{
local $ENV{HOME} = '/wibble/whomp';
local $ENV{USERPROFILE} = $ENV{HOME};
is( detildefy('~'), "/wibble/whomp");
}
skip "On OS/2 EMX all users are equal", 2 if $^O eq 'os2';
is( detildefy('~~'), '~~' );
is( detildefy('~ fooxzy'), '~ fooxzy' );
}
# Again, with named users
SKIP: {
my @info = eval { getpwuid $> };
skip "No home directory for tilde-expansion tests", 1 if $@ or !defined $info[7] or !defined $info[0];
my ($me, $home) = @info[0,7];
my $expected = "$home/fooxzy";
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 . '/../[^/]+' . '/fooxzy';
}
like( detildefy("~$me/fooxzy"), qr(\Q$expected\E)i );
}
|
