Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
actions	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
bundled	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
compat	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
properties	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
00-compile.t	357 B	-r--r--r--	2014-12-27 11:49
PL_files.t	2.18 KB	-r--r--r--	2014-12-27 11:49
README.pod	2.94 KB	-r--r--r--	2014-12-27 11:49
add_property.t	3.1 KB	-r--r--r--	2014-12-27 11:49
add_property_array.t	349 B	-r--r--r--	2014-12-27 11:49
add_property_hash.t	351 B	-r--r--r--	2014-12-27 11:49
basic.t	6.48 KB	-r--r--r--	2014-12-27 11:49
bundle_inc.t	6.02 KB	-r--r--r--	2014-12-27 11:49
compat.t	15.42 KB	-r--r--r--	2014-12-27 11:49
debug.t	555 B	-r--r--r--	2014-12-27 11:49
destinations.t	9.52 KB	-r--r--r--	2014-12-27 11:49
ext.t	5.91 KB	-r--r--r--	2014-12-27 11:49
extend.t	6.7 KB	-r--r--r--	2014-12-27 11:49
files.t	905 B	-r--r--r--	2014-12-27 11:49
help.t	5.2 KB	-r--r--r--	2014-12-27 11:49
install.t	6.03 KB	-r--r--r--	2014-12-27 11:49
install_extra_target.t	2.94 KB	-r--r--r--	2014-12-27 11:49
manifypods.t	3.53 KB	-r--r--r--	2014-12-27 11:49
manifypods_with_utf8.t	1.61 KB	-r--r--r--	2014-12-27 11:49
metadata.t	3.13 KB	-r--r--r--	2014-12-27 11:49
metadata2.t	2.93 KB	-r--r--r--	2014-12-27 11:49
mymeta.t	5.23 KB	-r--r--r--	2014-12-27 11:49
new_from_context.t	429 B	-r--r--r--	2014-12-27 11:49
notes.t	1.26 KB	-r--r--r--	2014-12-27 11:49
parents.t	1.34 KB	-r--r--r--	2014-12-27 11:49
perl_mb_opt.t	1.63 KB	-r--r--r--	2014-12-27 11:49
pod_parser.t	2.77 KB	-r--r--r--	2014-12-27 11:49
ppm.t	5.43 KB	-r--r--r--	2014-12-27 11:49
resume.t	989 B	-r--r--r--	2014-12-27 11:49
runthrough.t	4.88 KB	-r--r--r--	2014-12-27 11:49
sample.t	589 B	-r--r--r--	2014-12-27 11:49
script_dist.t	1.78 KB	-r--r--r--	2014-12-27 11:49
test_file_exts.t	959 B	-r--r--r--	2014-12-27 11:49
test_reqs.t	1.04 KB	-r--r--r--	2014-12-27 11:49
test_type.t	1.41 KB	-r--r--r--	2014-12-27 11:49
test_types.t	4.24 KB	-r--r--r--	2014-12-27 11:49
tilde.t	2.89 KB	-r--r--r--	2014-12-27 11:49
unit_run_test_harness.t	2.34 KB	-r--r--r--	2014-12-27 11:49
use_tap_harness.t	2.42 KB	-r--r--r--	2014-12-27 11:49
versions.t	502 B	-r--r--r--	2014-12-27 11:49
write_default_maniskip.t	932 B	-r--r--r--	2014-12-27 11:49
xs.t	4.38 KB	-r--r--r--	2014-12-27 11:49

Rename

#!/usr/bin/perl -w

# Test ~ expansion from command line arguments.

use strict;
use lib 't/lib';
use MBTest tests => 16;

blib_load('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", 15 if $@
        or !defined $info[7];
      $home = $info[7];
    }

is( run_sample( $p => '~'     )->$p(),  $home );

is( run_sample( $p => '~/fooxzy' )->$p(),  "$home/fooxzy" );

is( run_sample( $p => '~/ fooxzy')->$p(),  "$home/ fooxzy" );

is( run_sample( $p => '~/fo o')->$p(),  "$home/fo o" );

is( run_sample( $p => 'fooxzy~'  )->$p(),  'fooxzy~' );

is( run_sample( prefix => '~' )->prefix,
	$home );

# Test when HOME is different from getpwuid(), as in sudo.
    {
        local $ENV{HOME} = '/wibble/whomp';

is( run_sample( $p => '~' )->$p(),    "/wibble/whomp" );
    }

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' );

skip "On OS/2 EMX all users are equal", 2 if $^O eq 'os2';
    is( run_sample( $p => '~~'    )->$p(),  '~~' );
    is( run_sample( $p => '~ fooxzy' )->$p(),  '~ 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];

if ($^O eq 'VMS') {
        # Convert the path to UNIX format and trim off the trailing slash.
        # Also, the fake module we're in has mangled $ENV{HOME} for its own
        # purposes; getpwuid doesn't know about that but _detildefy does.
        $home = VMS::Filespec::unixify($ENV{HOME});
        $home =~ s#/$##;
    }
    my $expected = "$home/fooxzy";

like( run_sample( $p => "~$me/fooxzy")->$p(),  qr(\Q$expected\E)i );
}