dslinux/user/perl/lib/ExtUtils/t 00compile.t Command.t Constant.t Embed.t FIRST_MAKEFILE.t INST.t INST_PREFIX.t Install.t Installed.t Liblist.t MM_Any.t MM_BeOS.t MM_Cygwin.t MM_NW5.t MM_OS2.t MM_Unix.t MM_VMS.t MM_Win32.t Manifest.t Mkbootstrap.t PL_FILES.t Packlist.t VERSION_FROM.t backwards.t basic.t bytes.t config.t dir_target.t hints.t installbase.t oneliner.t parse_version.t postamble.t prefixify.t prereq_print.t problems.t prompt.t recurs.t split_command.t testlib.t vmsish.t writemakefile_args.t xs.t

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:37 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/lib/ExtUtils/t
In directory antilope:/tmp/cvs-serv17422/lib/ExtUtils/t

Added Files:
	00compile.t Command.t Constant.t Embed.t FIRST_MAKEFILE.t 
	INST.t INST_PREFIX.t Install.t Installed.t Liblist.t MM_Any.t 
	MM_BeOS.t MM_Cygwin.t MM_NW5.t MM_OS2.t MM_Unix.t MM_VMS.t 
	MM_Win32.t Manifest.t Mkbootstrap.t PL_FILES.t Packlist.t 
	VERSION_FROM.t backwards.t basic.t bytes.t config.t 
	dir_target.t hints.t installbase.t oneliner.t parse_version.t 
	postamble.t prefixify.t prereq_print.t problems.t prompt.t 
	recurs.t split_command.t testlib.t vmsish.t 
	writemakefile_args.t xs.t 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: MM_Cygwin.t ---
#!/usr/bin/perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More;

BEGIN {
	if ($^O =~ /cygwin/i) {
		plan tests => 11;
	} else {
		plan skip_all => "This is not cygwin";
	}
}

use Config;
use File::Spec;
use ExtUtils::MM;

use_ok( 'ExtUtils::MM_Cygwin' );

# test canonpath
my $path = File::Spec->canonpath('/a/../../c');
is( MM->canonpath('/a/../../c'), $path,
	'canonpath() method should work just like the one in File::Spec' );

# test cflags, with the fake package below
my $MM = bless({
	CFLAGS	=> 'fakeflags',
	CCFLAGS	=> '',
}, 'MM');

# with CFLAGS set, it should be returned
is( $MM->cflags(), 'fakeflags',
	'cflags() should return CFLAGS member data, if set' );

delete $MM->{CFLAGS};

# ExtUtils::MM_Cygwin::cflags() calls this, fake the output
{
    local $SIG{__WARN__} = sub { 
        warn @_ unless $_[0] =~ /^Subroutine .* redefined/;
    };
    *ExtUtils::MM_Unix::cflags = sub { return $_[1] };
}

# respects the config setting, should ignore whitespace around equal sign
my $ccflags = $Config{useshrplib} eq 'true' ? ' -DUSEIMPORTLIB' : '';
{
    local $MM->{NEEDS_LINKING} = 1;
    $MM->cflags(<<FLAGS);
OPTIMIZE = opt
PERLTYPE  =pt
FLAGS
}

like( $MM->{CFLAGS}, qr/OPTIMIZE = opt/, '... should set OPTIMIZE' );
like( $MM->{CFLAGS}, qr/PERLTYPE = pt/, '... should set PERLTYPE' );
like( $MM->{CFLAGS}, qr/CCFLAGS = $ccflags/, '... should set CCFLAGS' );

# test manifypods
$MM = bless({
	NOECHO => 'noecho',
	MAN3PODS => {},
	MAN1PODS => {},
    MAKEFILE => 'Makefile',
}, 'MM');
unlike( $MM->manifypods(), qr/foo/,
	'manifypods() should return without PODS values set' );

$MM->{MAN3PODS} = { foo => 'foo.1' };
my $res = $MM->manifypods();
like( $res, qr/pure_all.*foo.*foo.1/s, '... should add MAN3PODS targets' );


# init_linker
{
    my $libperl = $Config{libperl} || 'libperl.a';
    $libperl =~ s/\.a/.dll.a/ if $] >= 5.006002;
    $libperl = "\$(PERL_INC)/$libperl";

    my $export  = '';
    my $after   = '';
    $MM->init_linker;

    is( $MM->{PERL_ARCHIVE},        $libperl,   'PERL_ARCHIVE' );
    is( $MM->{PERL_ARCHIVE_AFTER},  $after,     'PERL_ARCHIVE_AFTER' );
    is( $MM->{EXPORT_LIST},         $export,    'EXPORT_LIST' );
}



package FakeOut;

sub TIEHANDLE {
	bless(\(my $scalar), $_[0]);
}

sub PRINT {
	my $self = shift;
	$$self .= shift;
}

--- NEW FILE: prompt.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 11;
use ExtUtils::MakeMaker;
use TieOut;
use TieIn;

eval q{
    prompt();
};
like( $@, qr/^Not enough arguments for ExtUtils::MakeMaker::prompt/,
                                            'no args' );

eval {
    prompt(undef);
};
like( $@, qr/^prompt function called without an argument/, 
                                            'undef message' );

my $stdout = tie *STDOUT, 'TieOut' or die;


$ENV{PERL_MM_USE_DEFAULT} = 1;
is( prompt("Foo?"), '',     'no default' );
like( $stdout->read,  qr/^Foo\?\s*\n$/,      '  question' );

is( prompt("Foo?", undef), '',     'undef default' );
like( $stdout->read,  qr/^Foo\?\s*\n$/,      '  question' );

is( prompt("Foo?", 'Bar!'), 'Bar!',     'default' );
like( $stdout->read,  qr/^Foo\? \[Bar!\]\s+Bar!\n$/,      '  question' );


SKIP: {
    skip "eof() doesn't honor ties in 5.5.3", 3 if $] < 5.006;

    $ENV{PERL_MM_USE_DEFAULT} = 0;
    close STDIN;
    my $stdin = tie *STDIN, 'TieIn' or die;
    $stdin->write("From STDIN");
    ok( !-t STDIN,      'STDIN not a tty' );

    is( prompt("Foo?", 'Bar!'), 'From STDIN',     'from STDIN' );
    like( $stdout->read,  qr/^Foo\? \[Bar!\]\s*$/,      '  question' );
}

--- NEW FILE: Liblist.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        unshift @INC, '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More tests => 6;


BEGIN {
    use_ok( 'ExtUtils::Liblist' );
}

ok( defined &ExtUtils::Liblist::ext, 
    'ExtUtils::Liblist::ext() defined for backwards compat' );

{
    my @warn;
    local $SIG{__WARN__} = sub {push @warn, [@_]};

    my $ll = bless {}, 'ExtUtils::Liblist';
    my @out = $ll->ext('-ln0tt43r3_perl');
    is( @out, 4, 'enough output' );
    unlike( $out[2], qr/-ln0tt43r3_perl/, 'bogus library not added' );
    ok( @warn, 'had warning');

    is( grep(/\QNote (probably harmless): No library found for \E(-l)?n0tt43r3_perl/, map { @$_ } @warn), 1 ) || diag join "\n", @warn;
}

--- NEW FILE: xs.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib/');
    }
    else {
        unshift @INC, 't/lib/';
    }
}
chdir 't';

use Test::More;
use MakeMaker::Test::Utils;

if( have_compiler() ) {
    plan tests => 1;
}
else {
    plan skip_all => "ExtUtils::CBuilder not installed or couldn't find a compiler";
}

pass("You have a compiler, isn't that great?");

--- NEW FILE: Manifest.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        unshift @INC, '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;

use Test::More tests => 49;
use Cwd;

use File::Spec;
use File::Path;
use File::Find;

my $Is_VMS = $^O eq 'VMS';

# We're going to be chdir'ing and modules are sometimes loaded on the
# fly in this test, so we need an absolute @INC.
@INC = map { File::Spec->rel2abs($_) } @INC;

# keep track of everything added so it can all be deleted
my %Files;
sub add_file {
    my ($file, $data) = @_;
    $data ||= 'foo';
    1 while unlink $file;  # or else we'll get multiple versions on VMS
    open( T, '>'.$file) or return;
    print T $data;
    ++$Files{$file};
    close T;
}

sub read_manifest {
    open( M, 'MANIFEST' ) or return;
    chomp( my @files = <M> );
    close M;
    return @files;
}

sub catch_warning {
    my $warn;
    local $SIG{__WARN__} = sub { $warn .= $_[0] };
    return join('', $_[0]->() ), $warn;
}

sub remove_dir {
    ok( rmdir( $_ ), "remove $_ directory" ) for @_;
}

# use module, import functions
BEGIN { 
    use_ok( 'ExtUtils::Manifest', 
            qw( mkmanifest manicheck filecheck fullcheck 
                maniread manicopy skipcheck maniadd) ); 
}

my $cwd = Cwd::getcwd();

# Just in case any old files were lying around.
rmtree('mantest');

ok( mkdir( 'mantest', 0777 ), 'make mantest directory' );
ok( chdir( 'mantest' ), 'chdir() to mantest' );
ok( add_file('foo'), 'add a temporary file' );

# there shouldn't be a MANIFEST there
my ($res, $warn) = catch_warning( \&mkmanifest ); 
# Canonize the order.
$warn = join("", map { "$_|" } 
                 sort { lc($a) cmp lc($b) } split /\r?\n/, $warn);
is( $warn, "Added to MANIFEST: foo|Added to MANIFEST: MANIFEST|",
    "mkmanifest() displayed its additions" );

# and now you see it
ok( -e 'MANIFEST', 'create MANIFEST file' );

my @list = read_manifest();
is( @list, 2, 'check files in MANIFEST' );
ok( ! ExtUtils::Manifest::filecheck(), 'no additional files in directory' );

# after adding bar, the MANIFEST is out of date
ok( add_file( 'bar' ), 'add another file' );
ok( ! manicheck(), 'MANIFEST now out of sync' );

# it reports that bar has been added and throws a warning
($res, $warn) = catch_warning( \&filecheck );

like( $warn, qr/^Not in MANIFEST: bar/, 'warning that bar has been added' );
is( $res, 'bar', 'bar reported as new' );

# now quiet the warning that bar was added and test again
($res, $warn) = do { local $ExtUtils::Manifest::Quiet = 1; 
                     catch_warning( \&skipcheck ) 
                };
ok( ! defined $warn, 'disabled warnings' );

# add a skip file with a rule to skip itself (and the nonexistent glob '*baz*')
add_file( 'MANIFEST.SKIP', "baz\n.SKIP" );

# this'll skip the new file
($res, $warn) = catch_warning( \&skipcheck );
like( $warn, qr/^Skipping MANIFEST\.SKIP/i, 'got skipping warning' );

my @skipped;
catch_warning( sub {
	@skipped = skipcheck()
});

is( join( ' ', @skipped ), 'MANIFEST.SKIP', 'listed skipped files' );

{
	local $ExtUtils::Manifest::Quiet = 1;
	is( join(' ', filecheck() ), 'bar', 'listing skipped with filecheck()' );
}

# add a subdirectory and a file there that should be found
ok( mkdir( 'moretest', 0777 ), 'created moretest directory' );
add_file( File::Spec->catfile('moretest', 'quux'), 'quux' );
ok( exists( ExtUtils::Manifest::manifind()->{'moretest/quux'} ), 
                                        "manifind found moretest/quux" );

# only MANIFEST and foo are in the manifest
$_ = 'foo';
my $files = maniread();
is( keys %$files, 2, 'two files found' );
is( join(' ', sort { lc($a) cmp lc($b) } keys %$files), 'foo MANIFEST', 
                                        'both files found' );
is( $_, 'foo', q{maniread() doesn't clobber $_} );

ok( mkdir( 'copy', 0777 ), 'made copy directory' );

# Check that manicopy copies files.
manicopy( $files, 'copy', 'cp' );
my @copies = ();
find( sub { push @copies, $_ if -f }, 'copy' );
@copies = map { s/\.$//; $_ } @copies if $Is_VMS;  # VMS likes to put dots on
                                                   # the end of files.
# Have to compare insensitively for non-case preserving VMS
is_deeply( [sort map { lc } @copies], [sort map { lc } keys %$files] );

# cp would leave files readonly, so check permissions.
foreach my $orig (@copies) {
    my $copy = "copy/$orig";
    ok( -r $copy,               "$copy: must be readable" );
    is( -w $copy, -w $orig,     "       writable if original was" );
    is( -x $copy, -x $orig,     "       executable if original was" );
}
rmtree('copy');


# poison the manifest, and add a comment that should be reported
add_file( 'MANIFEST', 'none #none' );
is( ExtUtils::Manifest::maniread()->{none}, '#none', 
                                        'maniread found comment' );

ok( mkdir( 'copy', 0777 ), 'made copy directory' );
$files = maniread();
eval { (undef, $warn) = catch_warning( sub {
 		manicopy( $files, 'copy', 'cp' ) }) 
};
like( $@, qr/^Can't read none: /, 'croaked about none' );

# a newline comes through, so get rid of it
chomp($warn);

# the copy should have given one warning and one error
like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' );

# tell ExtUtils::Manifest to use a different file
{
	local $ExtUtils::Manifest::MANIFEST = 'albatross'; 
	($res, $warn) = catch_warning( \&mkmanifest );
	like( $warn, qr/Added to albatross: /, 'using a new manifest file' );
	
	# add the new file to the list of files to be deleted
	$Files{'albatross'}++;
}


# Make sure MANIFEST.SKIP is using complete relative paths
add_file( 'MANIFEST.SKIP' => "^moretest/q\n" );

# This'll skip moretest/quux
($res, $warn) = catch_warning( \&skipcheck );
like( $warn, qr{^Skipping moretest/quux$}i, 'got skipping warning again' );


# There was a bug where entries in MANIFEST would be blotted out
# by MANIFEST.SKIP rules.
add_file( 'MANIFEST.SKIP' => 'foo' );
add_file( 'MANIFEST'      => "foobar\n"   );
add_file( 'foobar'        => '123' );
($res, $warn) = catch_warning( \&manicheck );
is( $res,  '',      'MANIFEST overrides MANIFEST.SKIP' );
is( $warn, undef,   'MANIFEST overrides MANIFEST.SKIP, no warnings' );

$files = maniread;
ok( !$files->{wibble},     'MANIFEST in good state' );
maniadd({ wibble => undef });
maniadd({ yarrow => "hock" });
$files = maniread;
is( $files->{wibble}, '',    'maniadd() with undef comment' );
is( $files->{yarrow}, 'hock','          with comment' );
is( $files->{foobar}, '',    '          preserved old entries' );

add_file('MANIFEST'   => 'Makefile.PL');
maniadd({ foo  => 'bar' });
$files = maniread;
# VMS downcases the MANIFEST.  We normalize it here to match.
%$files = map { (lc $_ => $files->{$_}) } keys %$files;
my %expect = ( 'makefile.pl' => '',
               'foo'    => 'bar'
             );
is_deeply( $files, \%expect, 'maniadd() vs MANIFEST without trailing newline');

add_file('MANIFEST'   => 'Makefile.PL');
maniadd({ foo => 'bar' });

SKIP: {
    chmod( 0400, 'MANIFEST' );
    skip "Can't make MANIFEST read-only", 2 if -w 'MANIFEST';

    eval {
        maniadd({ 'foo' => 'bar' });
    };
    is( $@, '',  "maniadd() won't open MANIFEST if it doesn't need to" );

    eval {
        maniadd({ 'grrrwoof' => 'yippie' });
    };
    like( $@, qr/^\Qmaniadd() could not open MANIFEST:\E/,  
                 "maniadd() dies if it can't open the MANIFEST" );

    chmod( 0600, 'MANIFEST' );
}


END {
	is( unlink( keys %Files ), keys %Files, 'remove all added files' );
	remove_dir( 'moretest', 'copy' );

	# now get rid of the parent directory
	ok( chdir( $cwd ), 'return to parent directory' );
	remove_dir( 'mantest' );
}


--- NEW FILE: problems.t ---
# Test problems in Makefile.PL's and hint files.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More tests => 6;
use ExtUtils::MM;
use MakeMaker::Test::Setup::Problem;
use TieOut;

my $MM = bless { DIR => ['subdir'] }, 'MM';

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir 'Problem-Module', "chdir'd to Problem-Module" ) ||
  diag("chdir failed: $!");


# Make sure when Makefile.PL's break, they issue a warning.
# Also make sure Makefile.PL's in subdirs still have '.' in @INC.
{
    my $stdout = tie *STDOUT, 'TieOut' or die;

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = join '', @_ };
    eval { $MM->eval_in_subdirs; };

    is( $stdout->read, qq{\@INC has .\n}, 'cwd in @INC' );
    like( $@, 
          qr{^ERROR from evaluation of .*subdir.*Makefile.PL: YYYAaaaakkk},
          'Makefile.PL death in subdir warns' );

    untie *STDOUT;
}

--- NEW FILE: hints.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib/');
    }
    else {
        unshift @INC, 't/lib/';
    }
}
chdir 't';

use File::Spec;

use Test::More tests => 3;

# Having the CWD in @INC masked a bug in finding hint files
my $curdir = File::Spec->curdir;
@INC = grep { $_ ne $curdir && $_ ne '.' } @INC;

mkdir('hints', 0777);
(my $os = $^O) =~ s/\./_/g;
my $hint_file = File::Spec->catfile('hints', "$os.pl");

open(HINT, ">$hint_file") || die "Can't write dummy hints file $hint_file: $!";
print HINT <<'CLOO';
$self->{CCFLAGS} = 'basset hounds got long ears';
CLOO
close HINT;

use TieOut;
use ExtUtils::MakeMaker;

my $out = tie *STDERR, 'TieOut';
my $mm = bless {}, 'ExtUtils::MakeMaker';
$mm->check_hints;
is( $mm->{CCFLAGS}, 'basset hounds got long ears' );
is( $out->read, "Processing hints file $hint_file\n" );

open(HINT, ">$hint_file") || die "Can't write dummy hints file $hint_file: $!";
print HINT <<'CLOO';
die "Argh!\n";
CLOO
close HINT;

$mm->check_hints;
is( $out->read, <<OUT, 'hint files produce errors' );
Processing hints file $hint_file
Argh!
OUT

END {
    use File::Path;
    rmtree ['hints'];
}

--- NEW FILE: dir_target.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib/');
    }
    else {
        unshift @INC, 't/lib/';
    }
}
chdir 't';

use Test::More tests => 1;
use ExtUtils::MakeMaker;

# dir_target() was typo'd as dir_targets()
can_ok('MM', 'dir_target');

--- NEW FILE: split_command.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

chdir 't';

use ExtUtils::MM;
use MakeMaker::Test::Utils;

my $Is_VMS   = $^O eq 'VMS';
my $Is_Win32 = $^O eq 'MSWin32';

use Test::More tests => 7;

my $perl = which_perl;
my $mm = bless { NAME => "Foo" }, "MM";

# I don't expect anything to have a length shorter than 256 chars.
cmp_ok( $mm->max_exec_len, '>=', 256,   'max_exec_len' );

my $echo = $mm->oneliner(q{print @ARGV}, ['-l']);

# Force a short command length to make testing split_command easier.
$mm->{_MAX_EXEC_LEN} = length($echo) + 15;
is( $mm->max_exec_len, $mm->{_MAX_EXEC_LEN}, '  forced a short max_exec_len' );

my @test_args = qw(foo bar baz yar car har ackapicklerootyjamboree);
my @cmds = $mm->split_command($echo, @test_args);
isnt( @cmds, 0 );

@results = _run(@cmds);
is( join('', @results), join('', @test_args));


my %test_args = ( foo => 42, bar => 23, car => 'har' );
$even_args = $mm->oneliner(q{print !(@ARGV % 2)});
@cmds = $mm->split_command($even_args, %test_args);
isnt( @cmds, 0 );

@results = _run(@cmds);
like( join('', @results ), qr/^1+$/,         'pairs preserved' );

is( $mm->split_command($echo), 0,  'no args means no commands' );


sub _run {
    my @cmds = @_;

    s{\$\(ABSPERLRUN\)}{$perl} foreach @cmds;
    if( $Is_VMS ) {
        s{-\n}{} foreach @cmds
    }
    elsif( $Is_Win32 ) {
        s{\\\n}{} foreach @cmds;
    }

    return map { s/\n+$//; $_ } map { `$_` } @cmds
}

--- NEW FILE: recurs.t ---
#!/usr/bin/perl -w

# This tests MakeMaker against recursive builds

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Config;

use Test::More tests => 25;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::Recurs;

# 'make disttest' sets a bunch of environment variables which interfere
# with our testing.
delete @ENV{qw(PREFIX LIB MAKEFLAGS)};

my $perl = which_perl();
my $Is_VMS = $^O eq 'VMS';

chdir('t');

perl_lib;

my $Touch_Time = calibrate_mtime();

$| = 1;

ok( setup_recurs(), 'setup' );
END { 
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir('Recurs'), q{chdir'd to Recurs} ) ||
    diag("chdir failed: $!");


# Check recursive Makefile building.
my @mpl_out = run(qq{$perl Makefile.PL});

cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
  diag(@mpl_out);

my $makefile = makefile_name();

ok( -e $makefile, 'Makefile written' );
ok( -e File::Spec->catfile('prj2',$makefile), 'sub Makefile written' );

my $make = make_run();

my $make_out = run("$make");
is( $?, 0, 'recursive make exited normally' ) || diag $make_out;

ok( chdir File::Spec->updir );
ok( teardown_recurs(), 'cleaning out recurs' );
ok( setup_recurs(),    '  setting up fresh copy' );
ok( chdir('Recurs'), q{chdir'd to Recurs} ) ||
    diag("chdir failed: $!");


# Check NORECURS
@mpl_out = run(qq{$perl Makefile.PL "NORECURS=1"});

cmp_ok( $?, '==', 0, 'Makefile.PL NORECURS=1 exited with zero' ) ||
  diag(@mpl_out);

$makefile = makefile_name();

ok( -e $makefile, 'Makefile written' );
ok( !-e File::Spec->catfile('prj2',$makefile), 'sub Makefile not written' );

$make = make_run();

run("$make");
is( $?, 0, 'recursive make exited normally' );


ok( chdir File::Spec->updir );
ok( teardown_recurs(), 'cleaning out recurs' );
ok( setup_recurs(),    '  setting up fresh copy' );
ok( chdir('Recurs'), q{chdir'd to Recurs} ) ||
    diag("chdir failed: $!");


# Check that arguments aren't stomped when they have .. prepended
# [rt.perl.org 4345]
@mpl_out = run(qq{$perl Makefile.PL "INST_SCRIPT=cgi"});

cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
  diag(@mpl_out);

$makefile = makefile_name();
my $submakefile = File::Spec->catfile('prj2',$makefile);

ok( -e $makefile,    'Makefile written' );
ok( -e $submakefile, 'sub Makefile written' );

my $inst_script = File::Spec->catdir(File::Spec->updir, 'cgi');
ok( open(MAKEFILE, $submakefile) ) || diag("Can't open $submakefile: $!");
{ local $/;  
  like( <MAKEFILE>, qr/^\s*INST_SCRIPT\s*=\s*\Q$inst_script\E/m, 
        'prepend .. not stomping WriteMakefile args' ) 
}
close MAKEFILE;

--- NEW FILE: MM_OS2.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More;
if ($^O =~ /os2/i) {
	plan( tests => 32 );
} else {
	plan( skip_all => "This is not OS/2" );
}

# for dlsyms, overridden in tests
BEGIN {
	package ExtUtils::MM_OS2;
	use subs 'system', 'unlink';
}

# for maybe_command
use File::Spec;

use_ok( 'ExtUtils::MM_OS2' );
ok( grep( 'ExtUtils::MM_OS2',  @MM::ISA), 
	'ExtUtils::MM_OS2 should be parent of MM' );

# dlsyms
my $mm = bless({ 
	SKIPHASH => { 
		dynamic => 1 
	}, 
	NAME => 'foo:bar::',
}, 'ExtUtils::MM_OS2');

is( $mm->dlsyms(), '', 
	'dlsyms() should return nothing with dynamic flag set' );

$mm->{BASEEXT} = 'baseext';
delete $mm->{SKIPHASH};
my $res = $mm->dlsyms();
like( $res, qr/baseext\.def: Makefile/,
	'... without flag, should return make targets' );
like( $res, qr/"DL_FUNCS" => {  }/, 
	'... should provide empty hash refs where necessary' );
like( $res, qr/"DL_VARS" => \[]/, '... and empty array refs too' );

$mm->{FUNCLIST} = 'funclist';
$res = $mm->dlsyms( IMPORTS => 'imports' );
like( $res, qr/"FUNCLIST" => .+funclist/, 
	'... should pick up values from object' );
like( $res, qr/"IMPORTS" => .+imports/, '... and allow parameter options too' );

my $can_write;
{
	local *OUT;
	$can_write = open(OUT, '>tmp_imp');
}

SKIP: {
	skip("Cannot write test files: $!", 7) unless $can_write;

	$mm->{IMPORTS} = { foo => 'bar' };

	local $@;
	eval { $mm->dlsyms() };
	like( $@, qr/Can.t mkdir tmp_imp/, 
		'... should die if directory cannot be made' );

	unlink('tmp_imp') or skip("Cannot remove test file: $!", 9);
	eval { $mm->dlsyms() };
	like( $@, qr/Malformed IMPORT/, 'should die from malformed import symbols');

	$mm->{IMPORTS} = { foo => 'bar.baz' };

	my @sysfail = ( 1, 0, 1 );
	my ($sysargs, $unlinked);

	*ExtUtils::MM_OS2::system = sub {
		$sysargs = shift;
		return shift @sysfail;
	};

	*ExtUtils::MM_OS2::unlink = sub {
		$unlinked++;
	};

	eval { $mm->dlsyms() };

	like( $sysargs, qr/^emximp/, '... should try to call system() though' );
	like( $@, qr/Cannot make import library/, 
		'... should die if emximp syscall fails' );

	# sysfail is 0 now, call emximp call should succeed
	eval { $mm->dlsyms() };
	is( $unlinked, 1, '... should attempt to unlink temp files' );
	like( $@, qr/Cannot extract import/, 
		'... should die if other syscall fails' );
	
	# make both syscalls succeed
	@sysfail = (0, 0);
	local $@;
	eval { $mm->dlsyms() };
	is( $@, '', '... should not die if both syscalls succeed' );
}

# static_lib
{
	my $called = 0;

	# avoid "used only once"
	local *ExtUtils::MM_Unix::static_lib;
	*ExtUtils::MM_Unix::static_lib = sub {
		$called++;
		return "\n\ncalled static_lib\n\nline2\nline3\n\nline4";
	};

	my $args = bless({ IMPORTS => {}, }, 'MM');

	# without IMPORTS as a populated hash, there will be no extra data
	my $ret = ExtUtils::MM_OS2::static_lib( $args );
	is( $called, 1, 'static_lib() should call parent method' );
	like( $ret, qr/^called static_lib/m,
		'... should return parent data unless IMPORTS exists' );

	$args->{IMPORTS} = { foo => 1};
	$ret = ExtUtils::MM_OS2::static_lib( $args );
	is( $called, 2, '... should call parent method if extra imports passed' );
	like( $ret, qr/^called static_lib\n\t\$\(AR\) \$\(AR_STATIC_ARGS\)/m, 
		'... should append make tags to first line from parent method' );
	like( $ret, qr/\$@\n\n\nline2\nline3\n\nline4/m, 
		'... should include remaining data from parent method' );

}

# replace_manpage_separator
my $sep = '//a///b//c/de';
is( ExtUtils::MM_OS2->replace_manpage_separator($sep), '.a.b.c.de',
	'replace_manpage_separator() should turn multiple slashes into periods' );

# maybe_command
{
	local *DIR;
	my ($dir, $noext, $exe, $cmd);
	my $found = 0;

	my ($curdir, $updir) = (File::Spec->curdir, File::Spec->updir);

	# we need:
	#	1) a directory
	#	2) an executable file with no extension
	# 	3) an executable file with the .exe extension
	# 	4) an executable file with the .cmd extension
	# we assume there will be one somewhere in the path
	# in addition, we need them to be unique enough they do not trip
	# an earlier file test in maybe_command().  Portability.

	foreach my $path (split(/:/, $ENV{PATH})) {
		opendir(DIR, $path) or next;
		while (defined(my $file = readdir(DIR))) {
			next if $file eq $curdir or $file eq $updir;
			$file = File::Spec->catfile($path, $file);
			unless (defined $dir) {
				if (-d $file) {
					next if ( -x $file . '.exe' or -x $file . '.cmd' );
					
					$dir = $file;
					$found++;
				}
			}
			if (-x $file) {
				my $ext;
				if ($file =~ s/\.(exe|cmd)\z//) {
					$ext = $1;

					# skip executable files with names too similar
					next if -x $file;
					$file .= '.' . $ext;

				} else {
					unless (defined $noext) {
						$noext = $file;
						$found++;
					}
					next;
				}

				unless (defined $exe) {
					if ($ext eq 'exe') {
						$exe = $file;
						$found++;
						next;
					}
				}
				unless (defined $cmd) {
					if ($ext eq 'cmd') {
						$cmd = $file;
						$found++;
						next;
					}
				}
			}
			last if $found == 4;
		}
		last if $found == 4;
	}

	SKIP: {
		skip('No appropriate directory found', 1) unless defined $dir;
		is( ExtUtils::MM_OS2->maybe_command( $dir ), undef, 
			'maybe_command() should ignore directories' );
	}

	SKIP: {
		skip('No non-exension command found', 1) unless defined $noext;
		is( ExtUtils::MM_OS2->maybe_command( $noext ), $noext,
			'maybe_command() should find executable lacking file extension' );
	}

	SKIP: {
		skip('No .exe command found', 1) unless defined $exe;
		(my $noexe = $exe) =~ s/\.exe\z//;
		is( ExtUtils::MM_OS2->maybe_command( $noexe ), $exe,
			'maybe_command() should find .exe file lacking extension' );
	}

	SKIP: {
		skip('No .cmd command found', 1) unless defined $cmd;
		(my $nocmd = $cmd) =~ s/\.cmd\z//;
		is( ExtUtils::MM_OS2->maybe_command( $nocmd ), $cmd,
			'maybe_command() should find .cmd file lacking extension' );
	}
}

# file_name_is_absolute
ok( ExtUtils::MM_OS2->file_name_is_absolute( 's:/' ), 
	'file_name_is_absolute() should be true for paths with volume and slash' );
ok( ExtUtils::MM_OS2->file_name_is_absolute( '\foo' ), 
	'... and for paths with leading slash but no volume' );
ok( ! ExtUtils::MM_OS2->file_name_is_absolute( 'arduk' ), 
	'... but not for paths with no leading slash or volume' );


$mm->init_linker;

# PERL_ARCHIVE
is( $mm->{PERL_ARCHIVE}, '$(PERL_INC)/libperl$(LIB_EXT)', 'PERL_ARCHIVE' );

# PERL_ARCHIVE_AFTER
{
	my $aout = 0;
	local *OS2::is_aout;
	*OS2::is_aout = \$aout;
	
        $mm->init_linker;
	isnt( $mm->{PERL_ARCHIVE_AFTER}, '',
		'PERL_ARCHIVE_AFTER should be empty without $is_aout set' );
	$aout = 1;
	is( $mm->{PERL_ARCHIVE_AFTER}, 
            '$(PERL_INC)/libperl_override$(LIB_EXT)', 
		'... and has libperl_override if it is set' );
}

# EXPORT_LIST
is( $mm->{EXPORT_LIST}, '$(BASEEXT).def', 
	'EXPORT_LIST should add .def to BASEEXT member' );

END {
	use File::Path;
	rmtree('tmp_imp');
	unlink 'tmpimp.imp';
}

--- NEW FILE: MM_NW5.t ---
#!/usr/bin/perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        unshift @INC, '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';


use Test::More;

BEGIN {
	if ($^O =~ /NetWare/i) {
		plan tests => 40;
	} else {
		plan skip_all => 'This is not NW5';
	}
}

use Config;
use File::Spec;
use File::Basename;
use ExtUtils::MM;

require_ok( 'ExtUtils::MM_NW5' );

# Dummy MM object until we have a real MM init method.
my $MM = bless {
                DIR     => [],
                NOECHO  => '@',
                XS      => {},
                MAKEFILE => 'Makefile',
                RM_RF   => 'rm -rf',
                MV      => 'mv',
               }, 'MM';


# replace_manpage_separator() => tr|/|.|s ?
{
    my $man = 'a/path/to//something';
    ( my $replaced = $man ) =~ tr|/|.|s;
    is( $MM->replace_manpage_separator( $man ),
        $replaced, 'replace_manpage_separator()' );
}

# maybe_command()
SKIP: {
    skip( '$ENV{COMSPEC} not set', 2 )
        unless $ENV{COMSPEC} =~ m!((?:[a-z]:)?[^|<>]+)!i;
    my $comspec = $1;
    is( $MM->maybe_command( $comspec ), 
        $comspec, 'COMSPEC is a maybe_command()' );
    ( my $comspec2 = $comspec ) =~ s|\..{3}$||;
    like( $MM->maybe_command( $comspec2 ), 
          qr/\Q$comspec/i, 
          'maybe_command() without extension' );
}

my $had_pathext = exists $ENV{PATHEXT};
{
    local $ENV{PATHEXT} = '.exe';
    ok( ! $MM->maybe_command( 'not_a_command.com' ), 
        'not a maybe_command()' );
}
# Bug in Perl.  local $ENV{FOO} won't delete the key afterward.
delete $ENV{PATHEXT} unless $had_pathext;

# file_name_is_absolute() [Does not support UNC-paths]
{
    ok( $MM->file_name_is_absolute( 'SYS:/' ), 
        'file_name_is_absolute()' );
    ok( ! $MM->file_name_is_absolute( 'some/path/' ),
        'not file_name_is_absolute()' );

}

# find_perl() 
# Should be able to find running perl... $^X is OK on NW5
{
    my $my_perl = $1 if $^X  =~ /(.*)/; # are we in -T or -t?
    my( $perl, $path ) = fileparse( $my_perl );
    like( $MM->find_perl( $], [ $perl ], [ $path ] ), 
          qr/^\Q$my_perl\E$/i, 'find_perl() finds this perl' );
}

# catdir() (calls MM_NW5->canonpath)
{
    my @path_eg = qw( SYS trick dir/now_OK );

    is( $MM->catdir( @path_eg ), 
         'SYS\\trick\\dir\\now_OK', 'catdir()' );
    is( $MM->catdir( @path_eg ), 
        File::Spec->catdir( @path_eg ), 
        'catdir() eq File::Spec->catdir()' );

# catfile() (calls MM_NW5->catdir)
    push @path_eg, 'file.ext';

    is( $MM->catfile( @path_eg ),
        'SYS\\trick\\dir\\now_OK\\file.ext', 'catfile()' );

    is( $MM->catfile( @path_eg ), 
        File::Spec->catfile( @path_eg ), 
        'catfile() eq File::Spec->catfile()' );
}

# init_others(): check if all keys are created and set?
# qw( TOUCH CHMOD CP RM_F RM_RF MV NOOP TEST_F LD AR LDLOADLIBS DEV_NUL )
{
    my $mm_w32 = bless( {}, 'MM' );
    $mm_w32->init_others();
    my @keys = qw( TOUCH CHMOD CP RM_F RM_RF MV NOOP 
                   TEST_F LD AR LDLOADLIBS DEV_NULL );
    for my $key ( @keys ) {
        ok( $mm_w32->{ $key }, "init_others: $key" );
    }
}

# constants()
{
    my $mm_w32 = bless {
        NAME         => 'TestMM_NW5', 
        VERSION      => '1.00',
        VERSION_FROM => 'TestMM_NW5',
        PM           => { 'MM_NW5.pm' => 1 },
    }, 'MM';

    # XXX Hack until we have a proper init method.
    # Flesh out some necessary keys in the MM object.
    foreach my $key (qw(XS C O_FILES H HTMLLIBPODS HTMLSCRIPTPODS
                        MAN1PODS MAN3PODS PARENT_NAME)) {
        $mm_w32->{$key} = '';
    }
    my $s_PM = join( " \\\n\t", sort keys %{$mm_w32->{PM}} );
    my $k_PM = join( " \\\n\t", %{$mm_w32->{PM}} );

    like( $mm_w32->constants(),
          qr|^NAME\ =\ TestMM_NW5\s+VERSION\ =\ 1\.00.+
             MAKEMAKER\ =\ \Q$INC{'ExtUtils/MakeMaker.pm'}\E\s+
             MM_VERSION\ =\ \Q$ExtUtils::MakeMaker::VERSION\E.+
             VERSION_FROM\ =\ TestMM_NW5.+
             TO_INST_PM\ =\ \Q$s_PM\E\s+
             PM_TO_BLIB\ =\ \Q$k_PM\E
          |xs, 'constants()' );

}

# path()
my $had_path = exists $ENV{PATH};
{
    my @path_eg = ( qw( . .. ), 'SYS:\\Program Files' );
    local $ENV{PATH} = join ';', @path_eg;
    ok( eq_array( [ $MM->path() ], [ @path_eg ] ),
        'path() [preset]' );
}
# Bug in Perl.  local $ENV{FOO} will not delete key afterwards.
delete $ENV{PATH} unless $had_path;

# static_lib() should look into that
# dynamic_bs() should look into that
# dynamic_lib() should look into that

# clean()
{
    my $clean = $Config{cc} =~ /^gcc/i ? 'dll.base dll.exp' : '*.pdb';
    like( $MM->clean(), qr/^clean ::\s+\Q-$(RM_F) $clean\E\s+$/m,
          'clean() Makefile target' );
}


# init_linker
{
    my $libperl = $Config{libperl} || 'libperl.a';
    my $export  = '$(BASEEXT).def';
    my $after   = '';
    $MM->init_linker;

    is( $MM->{PERL_ARCHIVE},        $libperl,   'PERL_ARCHIVE' );
    is( $MM->{PERL_ARCHIVE_AFTER},  $after,     'PERL_ARCHIVE_AFTER' );
    is( $MM->{EXPORT_LIST},         $export,    'EXPORT_LIST' );
}


# canonpath()
{
    my $path = 'SYS:/TEMP';
    is( $MM->canonpath( $path ), File::Spec->canonpath( $path ),
	    'canonpath() eq File::Spec->canonpath' );
}

# perl_script()
my $script_ext  = '';
my $script_name = 'mm_w32tmp';
SKIP: {
    local *SCRIPT;
    skip( "Can't create temp file: $!", 4 )
        unless open SCRIPT, "> $script_name";
    print SCRIPT <<'EOSCRIPT';
#! perl
__END__
EOSCRIPT
    skip( "Can't write to temp file: $!", 4 )
        unless close SCRIPT;
    # now start tests:
    is( $MM->perl_script( $script_name ), 
        "${script_name}$script_ext", "perl_script ($script_ext)" );

    skip( "Can't rename temp file: $!", 3 )
        unless rename $script_name, "${script_name}.pl";
    $script_ext = '.pl';
    is( $MM->perl_script( $script_name ), 
        "${script_name}$script_ext", "perl_script ($script_ext)" );

    skip( "Can't rename temp file: $!", 2 )
        unless rename "${script_name}$script_ext", "${script_name}.bat";
    $script_ext = '.bat';
    is( $MM->perl_script( $script_name ), 
        "${script_name}$script_ext", "perl_script ($script_ext)" );

    skip( "Can't rename temp file: $!", 1 )
        unless rename "${script_name}$script_ext", "${script_name}.noscript";
    $script_ext = '.noscript';

    isnt( $MM->perl_script( $script_name ),
          "${script_name}$script_ext", 
          "not a perl_script anymore ($script_ext)" );
    is( $MM->perl_script( $script_name ), undef,
        "perl_script ($script_ext) returns empty" );
}
unlink "${script_name}$script_ext" if -f "${script_name}$script_ext";


# pm_to_blib()
{
    like( $MM->pm_to_blib(),
          qr/^pm_to_blib: \Q$(TO_INST_PM)\E.+\Q$(TOUCH) \E\$@\s+$/ms,
          'pm_to_blib' );
}

# tool_autosplit()
{
    my %attribs = ( MAXLEN => 255 );
    like( $MM->tool_autosplit( %attribs ),
          qr/^\#\ Usage:\ \$\(AUTOSPLITFILE\)
             \ FileToSplit\ AutoDirToSplitInto.+
             AUTOSPLITFILE\ =\ \$\(PERLRUN\)\ .+
             \$AutoSplit::Maxlen=$attribs{MAXLEN};
          /xms,
          'tool_autosplit()' );
}

# tools_other()
{
    ( my $mm_w32 = bless { }, 'MM' )->init_others();
        
    my $bin_sh = ( $Config{make} =~ /^dmake/i 
               ? "" : ($Config{sh} || 'cmd /c') . "\n" );
    $bin_sh = "SHELL = $bin_sh" if $bin_sh;

    my $tools = join "\n", map "$_ = $mm_w32->{ $_ }"
    	=> qw(CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL);

    like( $mm_w32->tools_other(),
          qr/^\Q$bin_sh$tools/m,
          'tools_other()' );
};

# xs_o() should look into that
# top_targets() should look into that

# dist_ci() should look into that
# dist_core() should look into that

# pasthru()
{
    my $pastru = "PASTHRU = " . ($Config{make} =~ /^nmake/i ? "-nologo" : "");
    is( $MM->pasthru(), $pastru, 'pasthru()' );
}

package FakeOut;

sub TIEHANDLE {
	bless(\(my $scalar), $_[0]);
}

sub PRINT {
	my $self = shift;
	$$self .= shift;
}

__END__

=head1 NAME

MM_NW5.t - Tests for ExtUtils::MM_NW5

=head1 TODO

 - Methods to still be checked:
 # static_lib() should look into that
 # dynamic_bs() should look into that
 # dynamic_lib() should look into that
 # xs_o() should look into that
 # top_targets() should look into that
 # dist_ci() should look into that
 # dist_core() should look into that

=head1 AUTHOR

20011228 Abe Timmerman <abe at ztreet.demon.nl>

=cut

--- NEW FILE: basic.t ---
#!/usr/bin/perl -w

# This test puts MakeMaker through the paces of a basic perl module
# build, test and installation of the Big::Fat::Dummy module.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Config;

use Test::More tests => 80;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;
use File::Find;
use File::Spec;
use File::Path;

# 'make disttest' sets a bunch of environment variables which interfere
# with our testing.
delete @ENV{qw(PREFIX LIB MAKEFLAGS)};

my $perl = which_perl();
my $Is_VMS = $^O eq 'VMS';

chdir 't';

perl_lib;

my $Touch_Time = calibrate_mtime();

$| = 1;

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) ||
  diag("chdir failed: $!");

my @mpl_out = run(qq{$perl Makefile.PL "PREFIX=../dummy-install"});
END { rmtree '../dummy-install'; }

cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
  diag(@mpl_out);

my $makefile = makefile_name();
ok( grep(/^Writing $makefile for Big::Dummy/, 
         @mpl_out) == 1,
                                           'Makefile.PL output looks right');

ok( grep(/^Current package is: main$/,
         @mpl_out) == 1,
                                           'Makefile.PL run in package main');

ok( -e $makefile,       'Makefile exists' );

# -M is flakey on VMS
my $mtime = (stat($makefile))[9];
cmp_ok( $Touch_Time, '<=', $mtime,  '  its been touched' );

END { unlink makefile_name(), makefile_backup() }

my $make = make_run();

{
    # Supress 'make manifest' noise
    local $ENV{PERL_MM_MANIFEST_VERBOSE} = 0;
    my $manifest_out = run("$make manifest");
    ok( -e 'MANIFEST',      'make manifest created a MANIFEST' );
    ok( -s 'MANIFEST',      '  its not empty' );
}

END { unlink 'MANIFEST'; }


my $ppd_out = run("$make ppd");
is( $?, 0,                      '  exited normally' ) || diag $ppd_out;
ok( open(PPD, 'Big-Dummy.ppd'), '  .ppd file generated' );
my $ppd_html;
{ local $/; $ppd_html = <PPD> }
close PPD;
like( $ppd_html, qr{^<SOFTPKG NAME="Big-Dummy" VERSION="0,01,0,0">}m, 
                                                           '  <SOFTPKG>' );
like( $ppd_html, qr{^\s*<TITLE>Big-Dummy</TITLE>}m,        '  <TITLE>'   );
like( $ppd_html, qr{^\s*<ABSTRACT>Try "our" hot dog's</ABSTRACT>}m,         
                                                           '  <ABSTRACT>');
like( $ppd_html, 
      qr{^\s*<AUTHOR>Michael G Schwern &lt;schwern\@pobox.com&gt;</AUTHOR>}m,
                                                           '  <AUTHOR>'  );
like( $ppd_html, qr{^\s*<IMPLEMENTATION>}m,          '  <IMPLEMENTATION>');
like( $ppd_html, qr{^\s*<DEPENDENCY NAME="strict" VERSION="0,0,0,0" />}m,
                                                           '  <DEPENDENCY>' );
like( $ppd_html, qr{^\s*<OS NAME="$Config{osname}" />}m,
                                                           '  <OS>'      );
like( $ppd_html, qr{^\s*<ARCHITECTURE NAME="$Config{archname}" />}m,  
                                                           '  <ARCHITECTURE>');
like( $ppd_html, qr{^\s*<CODEBASE HREF="" />}m,            '  <CODEBASE>');
like( $ppd_html, qr{^\s*</IMPLEMENTATION>}m,           '  </IMPLEMENTATION>');
like( $ppd_html, qr{^\s*</SOFTPKG>}m,                      '  </SOFTPKG>');
END { unlink 'Big-Dummy.ppd' }


my $test_out = run("$make test");
like( $test_out, qr/All tests successful/, 'make test' );
is( $?, 0,                                 '  exited normally' ) || 
    diag $test_out;

# Test 'make test TEST_VERBOSE=1'
my $make_test_verbose = make_macro($make, 'test', TEST_VERBOSE => 1);
$test_out = run("$make_test_verbose");
like( $test_out, qr/ok \d+ - TEST_VERBOSE/, 'TEST_VERBOSE' );
like( $test_out, qr/All tests successful/,  '  successful' );
is( $?, 0,                                  '  exited normally' ) ||
    diag $test_out;


my $install_out = run("$make install");
is( $?, 0, 'install' ) || diag $install_out;
like( $install_out, qr/^Installing /m );
like( $install_out, qr/^Writing /m );

ok( -r '../dummy-install',     '  install dir created' );
my %files = ();
find( sub { 
    # do it case-insensitive for non-case preserving OSs
    my $file = lc $_;

    # VMS likes to put dots on the end of things that don't have them.
    $file =~ s/\.$// if $Is_VMS;

    $files{$file} = $File::Find::name; 
}, '../dummy-install' );
ok( $files{'dummy.pm'},     '  Dummy.pm installed' );
ok( $files{'liar.pm'},      '  Liar.pm installed'  );
ok( $files{'program'},      '  program installed'  );
ok( $files{'.packlist'},    '  packlist created'   );
ok( $files{'perllocal.pod'},'  perllocal.pod created' );


SKIP: {
    skip 'VMS install targets do not preserve $(PREFIX)', 9 if $Is_VMS;

    $install_out = run("$make install PREFIX=elsewhere");
    is( $?, 0, 'install with PREFIX override' ) || diag $install_out;
    like( $install_out, qr/^Installing /m );
    like( $install_out, qr/^Writing /m );

    ok( -r 'elsewhere',     '  install dir created' );
    %files = ();
    find( sub { $files{$_} = $File::Find::name; }, 'elsewhere' );
    ok( $files{'Dummy.pm'},     '  Dummy.pm installed' );
    ok( $files{'Liar.pm'},      '  Liar.pm installed'  );
    ok( $files{'program'},      '  program installed'  );
    ok( $files{'.packlist'},    '  packlist created'   );
    ok( $files{'perllocal.pod'},'  perllocal.pod created' );
    rmtree('elsewhere');
}


SKIP: {
    skip 'VMS install targets do not preserve $(DESTDIR)', 11 if $Is_VMS;

    $install_out = run("$make install PREFIX= DESTDIR=other");
    is( $?, 0, 'install with DESTDIR' ) || 
        diag $install_out;
    like( $install_out, qr/^Installing /m );
    like( $install_out, qr/^Writing /m );

    ok( -d 'other',  '  destdir created' );
    %files = ();
    my $perllocal;
    find( sub { 
        $files{$_} = $File::Find::name;
    }, 'other' );
    ok( $files{'Dummy.pm'},     '  Dummy.pm installed' );
    ok( $files{'Liar.pm'},      '  Liar.pm installed'  );
    ok( $files{'program'},      '  program installed'  );
    ok( $files{'.packlist'},    '  packlist created'   );
    ok( $files{'perllocal.pod'},'  perllocal.pod created' );

    ok( open(PERLLOCAL, $files{'perllocal.pod'} ) ) || 
        diag("Can't open $files{'perllocal.pod'}: $!");
    { local $/;
      unlike(<PERLLOCAL>, qr/other/, 'DESTDIR should not appear in perllocal');
    }
    close PERLLOCAL;

# TODO not available in the min version of Test::Harness we require
#    ok( open(PACKLIST, $files{'.packlist'} ) ) || 
#        diag("Can't open $files{'.packlist'}: $!");
#    { local $/;
#      local $TODO = 'DESTDIR still in .packlist';
#      unlike(<PACKLIST>, qr/other/, 'DESTDIR should not appear in .packlist');
#    }
#    close PACKLIST;

    rmtree('other');
}


SKIP: {
    skip 'VMS install targets do not preserve $(PREFIX)', 10 if $Is_VMS;

    $install_out = run("$make install PREFIX=elsewhere DESTDIR=other/");
    is( $?, 0, 'install with PREFIX override and DESTDIR' ) || 
        diag $install_out;
    like( $install_out, qr/^Installing /m );
    like( $install_out, qr/^Writing /m );

    ok( !-d 'elsewhere',       '  install dir not created' );
    ok( -d 'other/elsewhere',  '  destdir created' );
    %files = ();
    find( sub { $files{$_} = $File::Find::name; }, 'other/elsewhere' );
    ok( $files{'Dummy.pm'},     '  Dummy.pm installed' );
    ok( $files{'Liar.pm'},      '  Liar.pm installed'  );
    ok( $files{'program'},      '  program installed'  );
    ok( $files{'.packlist'},    '  packlist created'   );
    ok( $files{'perllocal.pod'},'  perllocal.pod created' );
    rmtree('other');
}


my $dist_test_out = run("$make disttest");
is( $?, 0, 'disttest' ) || diag($dist_test_out);

# Test META.yml generation
use ExtUtils::Manifest qw(maniread);

my $distdir  = 'Big-Dummy-0.01';
$distdir =~ s/\./_/g if $Is_VMS;
my $meta_yml = "$distdir/META.yml";

ok( !-f 'META.yml',  'META.yml not written to source dir' );
ok( -f $meta_yml,    'META.yml written to dist dir' );
ok( !-e "META_new.yml", 'temp META.yml file not left around' );

my $manifest = maniread("$distdir/MANIFEST");
# VMS is non-case preserving, so we can't know what the MANIFEST will
# look like. :(
_normalize($manifest);
is( $manifest->{'meta.yml'}, 'Module meta-data (added by MakeMaker)' );


# Test NO_META META.yml suppression
unlink $meta_yml;
ok( !-f $meta_yml,   'META.yml deleted' );
@mpl_out = run(qq{$perl Makefile.PL "NO_META=1"});
cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out);
my $distdir_out = run("$make distdir");
is( $?, 0, 'distdir' ) || diag($distdir_out);
ok( !-f $meta_yml,   'META.yml generation suppressed by NO_META' );


# Make sure init_dirscan doesn't go into the distdir
@mpl_out = run(qq{$perl Makefile.PL "PREFIX=../dummy-install"});

cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out);

ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1,
                                'init_dirscan skipped distdir') || 
  diag(@mpl_out);

# I know we'll get ignored errors from make here, that's ok.
# Send STDERR off to oblivion.
open(SAVERR, ">&STDERR") or die $!;
open(STDERR, ">".File::Spec->devnull) or die $!;

my $realclean_out = run("$make realclean");
is( $?, 0, 'realclean' ) || diag($realclean_out);

open(STDERR, ">&SAVERR") or die $!;
close SAVERR;


sub _normalize {
    my $hash = shift;

    while(my($k,$v) = each %$hash) {
        delete $hash->{$k};
        $hash->{lc $k} = $v;
    }
}

--- NEW FILE: MM_Unix.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

BEGIN { 
    use Test::More; 

    if( $^O =~ /^VMS|os2|MacOS|MSWin32|cygwin|beos|netware$/i ) {
        plan skip_all => 'Non-Unix platform';
    }
    else {
        plan tests => 110;
    }
}

BEGIN { use_ok( 'ExtUtils::MM_Unix' ); }

use strict;
use File::Spec;

my $class = 'ExtUtils::MM_Unix';

# only one of the following can be true
# test should be removed if MM_Unix ever stops handling other OS than Unix
my $os =  ($ExtUtils::MM_Unix::Is_OS2 	|| 0)
	+ ($ExtUtils::MM_Unix::Is_Win32 || 0) 
	+ ($ExtUtils::MM_Unix::Is_Dos 	|| 0)
	+ ($ExtUtils::MM_Unix::Is_VMS   || 0); 
ok ( $os <= 1,  'There can be only one (or none)');

cmp_ok ($ExtUtils::MM_Unix::VERSION, '>=', '1.12606', 'Should be at least version 1.12606');

# when the following calls like canonpath, catdir etc are replaced by
# File::Spec calls, the test's become a bit pointless

foreach ( qw( xx/ ./xx/ xx/././xx xx///xx) )
  {
  is ($class->canonpath($_), File::Spec->canonpath($_), "canonpath $_");
  }

is ($class->catdir('xx','xx'), File::Spec->catdir('xx','xx'),
     'catdir(xx, xx) => xx/xx');
is ($class->catfile('xx','xx','yy'), File::Spec->catfile('xx','xx','yy'),
     'catfile(xx, xx) => xx/xx');

is ($class->file_name_is_absolute('Bombdadil'), 
    File::Spec->file_name_is_absolute('Bombdadil'),
     'file_name_is_absolute()');

is ($class->path(), File::Spec->path(), 'path() same as File::Spec->path()');

foreach (qw/updir curdir rootdir/)
  {
  is ($class->$_(), File::Spec->$_(), $_ );
  }

foreach ( qw /
  c_o
  clean
  const_cccmd
  const_config
  const_loadlibs
  constants
  depend
  dist
  dist_basics
  dist_ci
  dist_core
  distdir
  dist_test
  dlsyms
  dynamic
  dynamic_bs
  dynamic_lib
  exescan
  extliblist
  find_perl
  fixin
  force
  guess_name
  init_dirscan
  init_main
  init_others
  install
  installbin
  linkext
  lsdir
  macro
  makeaperl
  makefile
  manifypods
  needs_linking
  pasthru
  perldepend
  pm_to_blib
  ppd
  prefixify
  processPL
  quote_paren
  realclean
  static
  static_lib
  staticmake
  subdir_x
  subdirs
  test
  test_via_harness
  test_via_script
  tool_autosplit
  tool_xsubpp
  tools_other
  top_targets
  writedoc
  xs_c
  xs_cpp
  xs_o
  / )
  {
      can_ok($class, $_);
  }

###############################################################################
# some more detailed tests for the methods above

ok ( join (' ', $class->dist_basics()), 'distclean :: realclean distcheck');

###############################################################################
# has_link_code tests

my $t = bless { NAME => "Foo" }, $class;
$t->{HAS_LINK_CODE} = 1; 
is ($t->has_link_code(),1,'has_link_code'); is ($t->{HAS_LINK_CODE},1);

$t->{HAS_LINK_CODE} = 0;
is ($t->has_link_code(),0); is ($t->{HAS_LINK_CODE},0);

delete $t->{HAS_LINK_CODE}; delete $t->{OBJECT};
is ($t->has_link_code(),0); is ($t->{HAS_LINK_CODE},0);

delete $t->{HAS_LINK_CODE}; $t->{OBJECT} = 1;
is ($t->has_link_code(),1); is ($t->{HAS_LINK_CODE},1);

delete $t->{HAS_LINK_CODE}; delete $t->{OBJECT}; $t->{MYEXTLIB} = 1;
is ($t->has_link_code(),1); is ($t->{HAS_LINK_CODE},1);

delete $t->{HAS_LINK_CODE}; delete $t->{MYEXTLIB}; $t->{C} = [ 'Gloin' ];
is ($t->has_link_code(),1); is ($t->{HAS_LINK_CODE},1);

###############################################################################
# libscan

is ($t->libscan('foo/RCS/bar'),     '', 'libscan on RCS');
is ($t->libscan('CVS/bar/car'),     '', 'libscan on CVS');
is ($t->libscan('SCCS'),            '', 'libscan on SCCS');
is ($t->libscan('.svn/something'),  '', 'libscan on Subversion');
is ($t->libscan('foo/b~r'),         'foo/b~r',    'libscan on file with ~');
is ($t->libscan('foo/RCS.pm'),      'foo/RCS.pm', 'libscan on file with RCS');

is ($t->libscan('Fatty'), 'Fatty', 'libscan on something not a VC file' );

###############################################################################
# maybe_command

open(FILE, ">command"); print FILE "foo"; close FILE;
ok (!$t->maybe_command('command') ,"non executable file isn't a command");
chmod 0755, "command";
ok ($t->maybe_command('command'),        "executable file is a command");
unlink "command";

###############################################################################
# nicetext (dummy method)

is ($t->nicetext('LOTR'),'LOTR','nicetext');


###############################################################################
# perl_script (on unix any ordinary, readable file)

my $self_name = $ENV{PERL_CORE} ? '../lib/ExtUtils/t/MM_Unix.t' 
                                 : 'MM_Unix.t';
is ($t->perl_script($self_name),$self_name, 'we pass as a perl_script()');

###############################################################################
# perm_rw perm_rwx

$t->init_PERM;
is ($t->perm_rw(),'644', 'perm_rw() is 644');
is ($t->perm_rwx(),'755', 'perm_rwx() is 755');

###############################################################################
# post_constants, postamble, post_initialize

foreach (qw/ post_constants postamble post_initialize/)
  {
  is ($t->$_(),'', "$_() is an empty string");
  }

###############################################################################
# replace_manpage_separator 

is ($t->replace_manpage_separator('Foo/Bar'),'Foo::Bar','manpage_separator'); 

###############################################################################

$t->init_linker;
foreach (qw/ EXPORT_LIST PERL_ARCHIVE PERL_ARCHIVE_AFTER /)
{
    ok( exists $t->{$_}, "$_ was defined" );
    is( $t->{$_}, '', "$_ is empty on Unix"); 
}


{
    $t->{CCFLAGS} = '-DMY_THING';
    $t->{LIBPERL_A} = 'libperl.a';
    $t->{LIB_EXT}   = '.a';
    local $t->{NEEDS_LINKING} = 1;
    $t->cflags();

    # Brief bug where CCFLAGS was being blown away
    is( $t->{CCFLAGS}, '-DMY_THING',    'cflags retains CCFLAGS' );
}


--- NEW FILE: PL_FILES.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More tests => 9;

use File::Spec;
use MakeMaker::Test::Setup::PL_FILES;
use MakeMaker::Test::Utils;

my $perl = which_perl();
my $make = make_run();
perl_lib();

setup;

END { 
    ok( chdir File::Spec->updir );
    ok( teardown );
}

ok chdir('PL_FILES-Module');

run(qq{$perl Makefile.PL});
cmp_ok( $?, '==', 0 );

my $make_out = run("$make");
is( $?, 0 ) || diag $make_out;

foreach my $file (qw(single.out 1.out 2.out blib/lib/PL/Bar.pm)) {
    ok( -e $file, "$file was created" );
}

--- NEW FILE: installbase.t ---
#!/usr/bin/perl -w

# Tests INSTALLBASE

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use File::Path;
use Config;

use Test::More tests => 21;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;

my $Is_VMS = $^O eq 'VMS';

my $perl = which_perl();

chdir 't';
perl_lib;

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy") || diag("chdir failed; $!");

my @mpl_out = run(qq{$perl Makefile.PL "INSTALLBASE=../dummy-install"});
END { rmtree '../dummy-install'; }

cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
  diag(@mpl_out);

my $makefile = makefile_name();
ok( grep(/^Writing $makefile for Big::Dummy/, 
         @mpl_out) == 1,
                                           'Makefile.PL output looks right');

my $make = make_run();
run("$make");   # this is necessary due to a dmake bug.
my $install_out = run("$make install");
is( $?, 0, '  make install exited normally' ) || diag $install_out;
like( $install_out, qr/^Installing /m );
like( $install_out, qr/^Writing /m );

ok( -r '../dummy-install',      '  install dir created' );

my @installed_files = 
  ('../dummy-install/lib/perl5/Big/Dummy.pm',
   '../dummy-install/lib/perl5/Big/Liar.pm',
   '../dummy-install/bin/program',
   "../dummy-install/lib/perl5/$Config{archname}/perllocal.pod",
   "../dummy-install/lib/perl5/$Config{archname}/auto/Big/Dummy/.packlist"
  );

foreach my $file (@installed_files) {
    ok( -e $file, "  $file installed" );
    ok( -r $file, "  $file readable" );
}


# nmake outputs its damned logo
# Send STDERR off to oblivion.
open(SAVERR, ">&STDERR") or die $!;
open(STDERR, ">".File::Spec->devnull) or die $!;

my $realclean_out = run("$make realclean");
is( $?, 0, 'realclean' ) || diag($realclean_out);

open(STDERR, ">&SAVERR") or die $!;
close SAVERR;

--- NEW FILE: Installed.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib/';
    }
}
chdir 't';

my $Is_VMS = $^O eq 'VMS';

use strict;

use Config;
use Cwd;
use File::Path;
use File::Basename;
use File::Spec;

use Test::More tests => 46;

BEGIN { use_ok( 'ExtUtils::Installed' ) }

my $mandirs =  !!$Config{man1direxp} + !!$Config{man3direxp};

# saves having to qualify package name for class methods
my $ei = bless( {}, 'ExtUtils::Installed' );

# _is_prefix
ok( $ei->_is_prefix('foo/bar', 'foo'),
        '_is_prefix() should match valid path prefix' );
ok( !$ei->_is_prefix('\foo\bar', '\bar'),
        '... should not match wrong prefix' );

# _is_type
ok( $ei->_is_type(0, 'all'), '_is_type() should be true for type of "all"' );

foreach my $path (qw( man1dir man3dir )) {
    SKIP: {
        my $dir = $Config{$path.'exp'};
        skip("no man directory $path on this system", 2 ) unless $dir;

        my $file = $dir . '/foo';
        ok( $ei->_is_type($file, 'doc'),   "... should find doc file in $path" );
        ok( !$ei->_is_type($file, 'prog'), "... but not prog file in $path" );
    }
}

# VMS 5.6.1 doesn't seem to have $Config{prefixexp}
my $prefix = $Config{prefix} || $Config{prefixexp};

# You can concatenate /foo but not foo:, which defaults in the current 
# directory
$prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;

# ActivePerl 5.6.1/631 has $Config{prefixexp} as 'p:' for some reason
$prefix = $Config{prefix} if $prefix eq 'p:' && $^O eq 'MSWin32';

ok( $ei->_is_type( File::Spec->catfile($prefix, 'bar'), 'prog'),
        "... should find prog file under $prefix" );

SKIP: {
    skip('no man directories on this system', 1) unless $mandirs;
    is( $ei->_is_type('bar', 'doc'), 0, 
	'... should not find doc file outside path' );
}

ok( !$ei->_is_type('bar', 'prog'),
        '... nor prog file outside path' );
ok( !$ei->_is_type('whocares', 'someother'), '... nor other type anywhere' );

# _is_under
ok( $ei->_is_under('foo'), '_is_under() should return true with no dirs' );

my @under = qw( boo bar baz );
ok( !$ei->_is_under('foo', @under), '... should find no file not under dirs');
ok( $ei->_is_under('baz', @under),  '... should find file under dir' );


rmtree 'auto/FakeMod';
ok( mkpath('auto/FakeMod') );
END { rmtree 'auto' }

ok(open(PACKLIST, '>auto/FakeMod/.packlist'));
print PACKLIST 'list';
close PACKLIST;

ok(open(FAKEMOD, '>auto/FakeMod/FakeMod.pm'));

print FAKEMOD <<'FAKE';
package FakeMod;
use vars qw( $VERSION );
$VERSION = '1.1.1';
1;
FAKE

close FAKEMOD;

{
    # avoid warning and death by localizing glob
    local *ExtUtils::Installed::Config;
    my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
    %ExtUtils::Installed::Config = (
        %Config,
        archlibexp         => cwd(),
        sitearchexp        => $fake_mod_dir,
    );

    # necessary to fool new()
    push @INC, $fake_mod_dir;

    my $realei = ExtUtils::Installed->new();
    isa_ok( $realei, 'ExtUtils::Installed' );
    isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
    is( $realei->{Perl}{version}, $Config{version}, 
        'new() should set Perl version from %Config' );

    ok( exists $realei->{FakeMod}, 'new() should find modules with .packlists');
    isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
    is( $realei->{FakeMod}{version}, '1.1.1', 
	'... should find version in modules' );
}

# modules
$ei->{$_} = 1 for qw( abc def ghi );
is( join(' ', $ei->modules()), 'abc def ghi', 
    'modules() should return sorted keys' );

# This didn't work for a long time due to a sort in scalar context oddity.
is( $ei->modules, 3,    'modules() in scalar context' );

# files
$ei->{goodmod} = { 
        packlist => { 
                ($Config{man1direxp} ? 
                    (File::Spec->catdir($Config{man1direxp}, 'foo') => 1) : 
                        ()),
                ($Config{man3direxp} ? 
                    (File::Spec->catdir($Config{man3direxp}, 'bar') => 1) : 
                        ()),
                File::Spec->catdir($prefix, 'foobar') => 1,
                foobaz  => 1,
        },
};

eval { $ei->files('badmod') };
like( $@, qr/badmod is not installed/,'files() should croak given bad modname');
eval { $ei->files('goodmod', 'badtype' ) };
like( $@, qr/type must be/,'files() should croak given bad type' );

my @files;
SKIP: {
    skip('no man directory man1dir on this system', 2) 
      unless $Config{man1direxp}; 
    @files = $ei->files('goodmod', 'doc', $Config{man1direxp});
    is( scalar @files, 1, '... should find doc file under given dir' );
    is( (grep { /foo$/ } @files), 1, '... checking file name' );
}
SKIP: {
    skip('no man directories on this system', 1) unless $mandirs;
    @files = $ei->files('goodmod', 'doc');
    is( scalar @files, $mandirs, '... should find all doc files with no dir' );
}

@files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
is( scalar @files, 0, '... should find no doc files given wrong dirs' );
@files = $ei->files('goodmod', 'prog');
is( scalar @files, 1, '... should find doc file in correct dir' );
like( $files[0], qr/foobar[>\]]?$/, '... checking file name' );
@files = $ei->files('goodmod');
is( scalar @files, 2 + $mandirs, '... should find all files with no type specified' );
my %dirnames = map { lc($_) => dirname($_) } @files;

# directories
my @dirs = $ei->directories('goodmod', 'prog', 'fake');
is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );

SKIP: {
    skip('no man directories on this system', 1) unless $mandirs;
    @dirs = $ei->directories('goodmod', 'doc');
    is( scalar @dirs, $mandirs, '... should find all files files() would' );
}
@dirs = $ei->directories('goodmod');
is( scalar @dirs, 2 + $mandirs, '... should find all files files() would, again' );
@files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } @files;
is( join(' ', @files), join(' ', @dirs), '... should sort output' );

# directory_tree
my $expectdirs = 
       ($mandirs == 2) && 
       (dirname($Config{man1direxp}) eq dirname($Config{man3direxp}))
       ? 3 : 2;
 
SKIP: {
    skip('no man directories on this system', 1) unless $mandirs;
    @dirs = $ei->directory_tree('goodmod', 'doc', $Config{man1direxp} ?
       dirname($Config{man1direxp}) : dirname($Config{man3direxp}));
    is( scalar @dirs, $expectdirs, 
        'directory_tree() should report intermediate dirs to those requested' );
}

my $fakepak = Fakepak->new(102);

$ei->{yesmod} = { 
        version         => 101,
        packlist        => $fakepak,
};

# these should all croak
foreach my $sub (qw( validate packlist version )) {
    eval { $ei->$sub('nomod') };
    like( $@, qr/nomod is not installed/, 
	  "$sub() should croak when asked about uninstalled module" );
}

# validate
is( $ei->validate('yesmod'), 'validated', 
        'validate() should return results of packlist validate() call' );

# packlist
is( ${ $ei->packlist('yesmod') }, 102, 
        'packlist() should report installed mod packlist' );

# version
is( $ei->version('yesmod'), 101, 
        'version() should report installed mod version' );


package Fakepak;

sub new {
    my $class = shift;
    bless(\(my $scalar = shift), $class);
}

sub validate {
    return 'validated'
}

--- NEW FILE: postamble.t ---
#!/usr/bin/perl -w

# Wherein we ensure that postamble works ok.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 8;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;
use ExtUtils::MakeMaker;
use TieOut;

chdir 't';
perl_lib;
$| = 1;

my $Makefile = makefile_name;

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir 'Big-Dummy', q{chdir'd to Big-Dummy} ) ||
        diag("chdir failed: $!");

{
    my $warnings = '';
    local $SIG{__WARN__} = sub {
        $warnings = join '', @_;
    };

    my $stdout = tie *STDOUT, 'TieOut' or die;
    my $mm = WriteMakefile(
                           NAME            => 'Big::Dummy',
                           VERSION_FROM    => 'lib/Big/Dummy.pm',
                           postamble       => {
                                               FOO => 1,
                                               BAR => "fugawazads"
                                              }
                          );
    is( $warnings, '', 'postamble argument not warned about' );
}

sub MY::postamble {
    my($self, %extra) = @_;

    is_deeply( \%extra, { FOO => 1, BAR => 'fugawazads' }, 
               'postamble args passed' );

    return <<OUT;
# This makes sure the postamble gets written
OUT

}


ok( open(MAKEFILE, $Makefile) ) or diag "Can't open $Makefile: $!";
{ local $/; 
  like( <MAKEFILE>, qr/^\# This makes sure the postamble gets written\n/m,
        'postamble added to the Makefile' );
}
close MAKEFILE;

--- NEW FILE: Packlist.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use Test::More tests => 34;

use_ok( 'ExtUtils::Packlist' );

is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' );

# new calls tie()
my $pl = ExtUtils::Packlist->new();
isa_ok( $pl, 'ExtUtils::Packlist' );
is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' );


$pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' );
is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' );
is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' );


ExtUtils::Packlist::STORE($pl, 'key', 'value');
is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' );


$pl->{data}{foo} = 'bar';
is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' );


# test FIRSTKEY and NEXTKEY
SKIP: {
	$pl->{data}{bar} = 'baz';
	skip('not enough keys to test FIRSTKEY', 2) 
      unless keys %{ $pl->{data} } > 2;

	# get the first and second key
	my ($first, $second) = keys %{ $pl->{data} };

	# now get a couple of extra keys, to mess with the hash iterator
	my $i = 0;
	for (keys %{ $pl->{data} } ) {
		last if $i++;
	}
	
	# finally, see if it really can get the first key again
	is( ExtUtils::Packlist::FIRSTKEY($pl), $first, 
		'FIRSTKEY() should be consistent' );

	is( ExtUtils::Packlist::NEXTKEY($pl), $second,
		'and NEXTKEY() should also be consistent' );
}


ok( ExtUtils::Packlist::EXISTS($pl, 'bar'), 'EXISTS() should find keys' );


ExtUtils::Packlist::DELETE($pl, 'bar');
ok( !(exists $pl->{data}{bar}), 'DELETE() should delete cleanly' );


ExtUtils::Packlist::CLEAR($pl);
is( keys %{ $pl->{data} }, 0, 'CLEAR() should wipe out data' );


# DESTROY does nothing...
can_ok( 'ExtUtils::Packlist', 'DESTROY' );


# write is a little more complicated
eval { ExtUtils::Packlist::write({}) };
like( $@, qr/No packlist filename/, 'write() should croak without packfile' );

eval { ExtUtils::Packlist::write({}, 'eplist') };
my $file_is_ready = $@ ? 0 : 1;
ok( $file_is_ready, 'write() can write a file' );

local *IN;

SKIP: {
	skip('cannot write files, some tests difficult', 3) unless $file_is_ready;

	# set this file to read-only
	chmod 0444, 'eplist';

	SKIP: {
	    skip("cannot write readonly files", 1) if -w 'eplist';

	    eval { ExtUtils::Packlist::write({}, 'eplist') };
	    like( $@, qr/Can't open file/, 'write() should croak on open failure' );
	}

	#'now set it back (tick here fixes vim syntax highlighting ;)
	chmod 0777, 'eplist';

	# and some test data to be read
	$pl->{data} = {
		single => 1,
		hash => {
			foo => 'bar',
			baz => 'bup',
		},
		'/./abc' => '',
	};
	eval { ExtUtils::Packlist::write($pl, 'eplist') };
	is( $@, '', 'write() should normally succeed' );
	is( $pl->{packfile}, 'eplist', 'write() should set packfile name' );

	$file_is_ready = open(IN, 'eplist');
}


eval { ExtUtils::Packlist::read({}) };
like( $@, qr/^No packlist filename/, 'read() should croak without packfile' );


eval { ExtUtils::Packlist::read({}, 'abadfilename') };
like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' );
#'open packfile for reading


# and more read() tests
SKIP: {
	skip("cannot open file for reading: $!", 5) unless $file_is_ready;
	my $file = do { local $/ = <IN> };

	like( $file, qr/single\n/, 'key with value should be available' );
	like( $file, qr!/\./abc\n!, 'key with no value should also be present' );
	like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' );
	like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear');
	close IN;

	eval{ ExtUtils::Packlist::read($pl, 'eplist') };
	is( $@, '', 'read() should normally succeed' );
	is( $pl->{data}{single}, undef, 'single keys should have undef value' );
	is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes');

	is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' );
	ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' );

	# give validate a valid and an invalid file to find
	$pl->{data} = {
		eplist => 1,
		fake => undef,
	};

	is( ExtUtils::Packlist::validate($pl), 1,
		'validate() should find missing files' );
	ExtUtils::Packlist::validate($pl, 1);
	ok( !exists $pl->{data}{fake}, 
		'validate() should remove missing files when prompted' );
	
	# one more new() test, to see if it calls read() successfully
	$pl = ExtUtils::Packlist->new('eplist');
}


# packlist_file, $pl should be set from write test
is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl',
	'packlist_file() should fetch packlist from passed hash' );
is( ExtUtils::Packlist::packlist_file($pl), 'eplist',
	'packlist_file() should fetch packlist from ExtUtils::Packlist object' );

END {
	1 while unlink qw( eplist );
}

--- NEW FILE: vmsish.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 1;

use_ok('ExtUtils::MakeMaker::vmsish');


--- NEW FILE: 00compile.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use File::Find;
use File::Spec;
use Test::More;

my $Has_Test_Pod;
BEGIN {
    $Has_Test_Pod = eval 'use Test::Pod 0.95; 1';
}

chdir File::Spec->updir;
my $manifest = File::Spec->catfile('MANIFEST');
open(MANIFEST, $manifest) or die "Can't open $manifest: $!";
my @modules = map { m{^lib/(\S+)}; $1 } 
              grep { m{^lib/ExtUtils/\S*\.pm} } 
              grep { !m{/t/} } <MANIFEST>;
chomp @modules;
close MANIFEST;

chdir 'lib';
plan tests => scalar @modules * 2;
foreach my $file (@modules) {
    # 5.8.0 has a bug about require alone in an eval.  Thus the extra
    # statement.
    eval { require($file); 1 };
    is( $@, '', "require $file" );

    SKIP: {
        skip "Test::Pod not installed", 1 unless $Has_Test_Pod;
        pod_file_ok($file);
    }
}

--- NEW FILE: FIRST_MAKEFILE.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More tests => 7;

use MakeMaker::Test::Setup::BFD;
use MakeMaker::Test::Utils;

my $perl = which_perl();
my $make = make_run();
perl_lib();


ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) ||
  diag("chdir failed: $!");

my @mpl_out = run(qq{$perl Makefile.PL FIRST_MAKEFILE=jakefile});
cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag @mpl_out;

ok( -e 'jakefile', 'FIRST_MAKEFILE honored' );

ok( grep(/^Writing jakefile for Big::Dummy/, @mpl_out) == 1,
					'Makefile.PL output looks right' );

--- NEW FILE: Constant.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    use Config;
    unless ($Config{usedl}) {
	print "1..0 # no usedl, skipping\n";
	exit 0;
    }
}

# use warnings;
use strict;
use ExtUtils::MakeMaker;
use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
use File::Spec;
use Cwd;

my $do_utf_tests = $] > 5.006;
my $better_than_56 = $] > 5.007;
# For debugging set this to 1.
my $keep_files = 0;
$| = 1;

# Because were are going to be changing directory before running Makefile.PL
my $perl = $^X;
# 5.005 doesn't have new enough File::Spec to have rel2abs. But actually we
# only need it when $^X isn't absolute, which is going to be 5.8.0 or later
# (where ExtUtils::Constant is in the core, and tests against the uninstalled
# perl)
$perl = File::Spec->rel2abs ($perl) unless $] < 5.006;
# ExtUtils::Constant::C_constant uses $^X inside a comment, and we want to
# compare output to ensure that it is the same. We were probably run as ./perl
# whereas we will run the child with the full path in $perl. So make $^X for
# us the same as our child will see.
$^X = $perl;
my $lib = $ENV{PERL_CORE} ? '../../../lib' : '../../blib/lib';
my $runperl = "$perl \"-I$lib\"";
print "# perl=$perl\n";

my $make = $Config{make};
$make = $ENV{MAKE} if exists $ENV{MAKE};
if ($^O eq 'MSWin32' && $make eq 'nmake') { $make .= " -nologo"; }

# VMS may be using something other than MMS/MMK
my $mms_or_mmk = 0;
if ($^O eq 'VMS') {
   $mms_or_mmk = 1 if (($make eq 'MMK') || ($make eq 'MMS'));
}

# Renamed by make clean
my $makefile = ($mms_or_mmk ? 'descrip' : 'Makefile');
my $makefile_ext = ($mms_or_mmk ? '.mms' : '');
my $makefile_rename = $makefile . ($mms_or_mmk ? '.mms_old' : '.old');

my $output = "output";
my $package = "ExtTest";
my $dir = "ext-$$";
my $subdir = 0;
# The real test counter.
my $realtest = 1;

my $orig_cwd = cwd;
my $updir = File::Spec->updir;
die "Can't get current directory: $!" unless defined $orig_cwd;

print "# $dir being created...\n";
mkdir $dir, 0777 or die "mkdir: $!\n";

END {
  if (defined $orig_cwd and length $orig_cwd) {
    chdir $orig_cwd or die "Can't chdir back to '$orig_cwd': $!";
    use File::Path;
    print "# $dir being removed...\n";
    rmtree($dir) unless $keep_files;
  } else {
    # Can't get here.
    die "cwd at start was empty, but directory '$dir' was created" if $dir;
  }
}

chdir $dir or die $!;
push @INC, '../../lib', '../../../lib';

sub check_for_bonus_files {
  my $dir = shift;
  my %expect = map {($^O eq 'VMS' ? lc($_) : $_), 1} @_;

  my $fail;
  opendir DIR, $dir or die "opendir '$dir': $!";
  while (defined (my $entry = readdir DIR)) {
    $entry =~ s/\.$// if $^O eq 'VMS';  # delete trailing dot that indicates no extension
    next if $expect{$entry};
    print "# Extra file '$entry'\n";
    $fail = 1;
  }

  closedir DIR or warn "closedir '.': $!";
  if ($fail) {
    print "not ok $realtest\n";
  } else {
    print "ok $realtest\n";
  }
  $realtest++;
}

sub build_and_run {
  my ($tests, $expect, $files) = @_;
  my $core = $ENV{PERL_CORE} ? ' PERL_CORE=1' : '';
  my @perlout = `$runperl Makefile.PL $core`;
  if ($?) {
    print "not ok $realtest # $runperl Makefile.PL failed: $?\n";
    print "# $_" foreach @perlout;
    exit($?);
  } else {
    print "ok $realtest\n";
  }
  $realtest++;

  if (-f "$makefile$makefile_ext") {
    print "ok $realtest\n";
  } else {
    print "not ok $realtest\n";
  }
  $realtest++;

  my @makeout;

  if ($^O eq 'VMS') { $make .= ' all'; }

  # Sometimes it seems that timestamps can get confused

  # make failed: 256
  # Makefile out-of-date with respect to Makefile.PL
  # Cleaning current config before rebuilding Makefile...
  # make -f Makefile.old clean > /dev/null 2>&1 || /bin/sh -c true
  # ../../perl "-I../../../lib" "-I../../../lib" Makefile.PL "PERL_CORE=1"
  # Checking if your kit is complete...                         
  # Looks good
  # Writing Makefile for ExtTest
  # ==> Your Makefile has been rebuilt. <==
  # ==> Please rerun the make command.  <==
  # false

  my $timewarp = (-M "Makefile.PL") - (-M "$makefile$makefile_ext");
  # Convert from days to seconds
  $timewarp *= 86400;
  print "# Makefile.PL is $timewarp second(s) older than $makefile$makefile_ext\n";
  if ($timewarp < 0) {
      # Sleep for a while to catch up.
      $timewarp = -$timewarp;
      $timewarp+=2;
      $timewarp = 10 if $timewarp > 10;
      print "# Sleeping for $timewarp second(s) to try to resolve this\n";
      sleep $timewarp;
  }

  print "# make = '$make'\n";
  @makeout = `$make`;
  if ($?) {
    print "not ok $realtest # $make failed: $?\n";
    print "# $_" foreach @makeout;
    exit($?);
  } else {
    print "ok $realtest\n";
  }
  $realtest++;

  if ($^O eq 'VMS') { $make =~ s{ all}{}; }

  if ($Config{usedl}) {
    print "ok $realtest # This is dynamic linking, so no need to make perl\n";
  } else {
    my $makeperl = "$make perl";
    print "# make = '$makeperl'\n";
    @makeout = `$makeperl`;
    if ($?) {
      print "not ok $realtest # $makeperl failed: $?\n";
      print "# $_" foreach @makeout;
      exit($?);
    } else {
      print "ok $realtest\n";
    }
  }
  $realtest++;

  my $maketest = "$make test";
  print "# make = '$maketest'\n";

  @makeout = `$maketest`;

  if (open OUTPUT, "<$output") {
    local $/; # Slurp it - faster.
    print <OUTPUT>;
    close OUTPUT or print "# Close $output failed: $!\n";
  } else {
    # Harness will report missing test results at this point.
    print "# Open <$output failed: $!\n";
  }

  $realtest += $tests;
  if ($?) {
    print "not ok $realtest # $maketest failed: $?\n";
    print "# $_" foreach @makeout;
  } else {
    print "ok $realtest - maketest\n";
  }
  $realtest++;

  # -x is busted on Win32 < 5.6.1, so we emulate it.
  my $regen;
  if( $^O eq 'MSWin32' && $] <= 5.006001 ) {
    open(REGENTMP, ">regentmp") or die $!;
    open(XS, "$package.xs")     or die $!;
    my $saw_shebang;
    while(<XS>) {
      $saw_shebang++ if /^#!.*/i ;
        print REGENTMP $_ if $saw_shebang;
    }
    close XS;  close REGENTMP;
    $regen = `$runperl regentmp`;
    unlink 'regentmp';
  }
  else {
    $regen = `$runperl -x $package.xs`;
  }
  if ($?) {
    print "not ok $realtest # $runperl -x $package.xs failed: $?\n";
  } else {
    print "ok $realtest - regen\n";
  }
  $realtest++;

  if ($expect eq $regen) {
    print "ok $realtest - regen worked\n";
  } else {
    print "not ok $realtest - regen worked\n";
    # open FOO, ">expect"; print FOO $expect;
    # open FOO, ">regen"; print FOO $regen; close FOO;
  }
  $realtest++;

  my $makeclean = "$make clean";
  print "# make = '$makeclean'\n";
  @makeout = `$makeclean`;
  if ($?) {
    print "not ok $realtest # $make failed: $?\n";
    print "# $_" foreach @makeout;
  } else {
    print "ok $realtest\n";
  }
  $realtest++;

  check_for_bonus_files ('.', @$files, $output, $makefile_rename, '.', '..');

  rename $makefile_rename, $makefile . $makefile_ext
    or die "Can't rename '$makefile_rename' to '$makefile$makefile_ext': $!";

  unlink $output or warn "Can't unlink '$output': $!";

  # Need to make distclean to remove ../../lib/ExtTest.pm
  my $makedistclean = "$make distclean";
  print "# make = '$makedistclean'\n";
  @makeout = `$makedistclean`;
  if ($?) {
    print "not ok $realtest # $make failed: $?\n";
    print "# $_" foreach @makeout;
  } else {
    print "ok $realtest\n";
  }
  $realtest++;

  check_for_bonus_files ('.', @$files, '.', '..');

  unless ($keep_files) {
    foreach (@$files) {
      unlink $_ or warn "unlink $_: $!";
    }
  }

  check_for_bonus_files ('.', '.', '..');
}

sub Makefile_PL {
  my $package = shift;
  ################ Makefile.PL
  # We really need a Makefile.PL because make test for a no dynamic linking perl
  # will run Makefile.PL again as part of the "make perl" target.
  my $makefilePL = "Makefile.PL";
  open FH, ">$makefilePL" or die "open >$makefilePL: $!\n";
  print FH <<"EOT";
#!$perl -w
use ExtUtils::MakeMaker;
WriteMakefile(
              'NAME'		=> "$package",
              'VERSION_FROM'	=> "$package.pm", # finds \$VERSION
              (\$] >= 5.005 ?
               (#ABSTRACT_FROM => "$package.pm", # XXX add this
                AUTHOR     => "$0") : ())
             );
EOT

  close FH or die "close $makefilePL: $!\n";
  return $makefilePL;
}

sub MANIFEST {
  my (@files) = @_;
  ################ MANIFEST
  # We really need a MANIFEST because make distclean checks it.
  my $manifest = "MANIFEST";
  push @files, $manifest;
  open FH, ">$manifest" or die "open >$manifest: $!\n";
  print FH "$_\n" foreach @files;
  close FH or die "close $manifest: $!\n";
  return @files;
}

sub write_and_run_extension {
  my ($name, $items, $export_names, $package, $header, $testfile, $num_tests)
    = @_;
  my $types = {};
  my $constant_types = constant_types(); # macro defs
  my $C_constant = join "\n",
    C_constant ($package, undef, "IV", $types, undef, undef, @$items);
  my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant

  my $expect = $constant_types . $C_constant .
    "\n#### XS Section:\n" . $XS_constant;

  print "# $name\n# $dir/$subdir being created...\n";
  mkdir $subdir, 0777 or die "mkdir: $!\n";
  chdir $subdir or die $!;

  my @files;

  ################ Header
  my $header_name = "test.h";
  push @files, $header_name;
  open FH, ">$header_name" or die "open >$header_name: $!\n";
  print FH $header or die $!;
  close FH or die "close $header_name: $!\n";

  ################ XS
  my $xs = "$package.xs";
  push @files, $xs;
  open FH, ">$xs" or die "open >$xs: $!\n";

  print FH <<'EOT';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
EOT

  # XXX Here doc these:
  print FH "#include \"$header_name\"\n\n";
  print FH $constant_types;
  print FH $C_constant, "\n";
  print FH "MODULE = $package		PACKAGE = $package\n";
  print FH "PROTOTYPES: ENABLE\n";
  print FH $XS_constant;
  close FH or die "close $xs: $!\n";

  ################ PM
  my $pm = "$package.pm";
  push @files, $pm;
  open FH, ">$pm" or die "open >$pm: $!\n";
  print FH "package $package;\n";
  print FH "use $];\n";

  print FH <<'EOT';

use strict;
EOT
  printf FH "use warnings;\n" unless $] < 5.006;
  print FH <<'EOT';
use Carp;

require Exporter;
require DynaLoader;
use vars qw ($VERSION @ISA @EXPORT_OK $AUTOLOAD);

$VERSION = '0.01';
@ISA = qw(Exporter DynaLoader);
EOT
  # Having this qw( in the here doc confuses cperl mode far too much to be
  # helpful. And I'm using cperl mode to edit this, even if you're not :-)
  print FH "\@EXPORT_OK = qw(\n";

  # Print the names of all our autoloaded constants
  print FH "\t$_\n" foreach (@$export_names);
  print FH ");\n";
  # Print the AUTOLOAD subroutine ExtUtils::Constant generated for us
  print FH autoload ($package, $]);
  print FH "bootstrap $package \$VERSION;\n1;\n__END__\n";
  close FH or die "close $pm: $!\n";

  ################ test.pl
  my $testpl = "test.pl";
  push @files, $testpl;
  open FH, ">$testpl" or die "open >$testpl: $!\n";
  # Standard test header (need an option to suppress this?)
  print FH <<"EOT" or die $!;
use strict;
use $package qw(@$export_names);

print "1..2\n";
if (open OUTPUT, ">$output") {
  print "ok 1\n";
  select OUTPUT;
} else {
  print "not ok 1 # Failed to open '$output': \$!\n";
  exit 1;
}
EOT
  print FH $testfile or die $!;
  print FH <<"EOT" or die $!;
select STDOUT;
if (close OUTPUT) {
  print "ok 2\n";
} else {
  print "not ok 2 # Failed to close '$output': \$!\n";
}
EOT
  close FH or die "close $testpl: $!\n";

  push @files, Makefile_PL($package);
  @files = MANIFEST (@files);

  build_and_run ($num_tests, $expect, \@files);

  chdir $updir or die "chdir '$updir': $!";
  ++$subdir;
}
# Tests are arrayrefs of the form
# $name, [items], [export_names], $package, $header, $testfile, $num_tests
my @tests;
my $before_tests = 4; # Number of "ok"s emitted to build extension
my $after_tests = 8; # Number of "ok"s emitted after make test run
my $dummytest = 1;

my $here;
sub start_tests {
  $dummytest += $before_tests;
  $here = $dummytest;
}
sub end_tests {
  my ($name, $items, $export_names, $header, $testfile) = @_;
  push @tests, [$name, $items, $export_names, $package, $header, $testfile,
               $dummytest - $here];
  $dummytest += $after_tests;
}

my $pound;
if (ord('A') == 193) {  # EBCDIC platform
  $pound = chr 177; # A pound sign. (Currency)
} else { # ASCII platform
  $pound = chr 163; # A pound sign. (Currency)
}
my @common_items = (
                    {name=>"perl", type=>"PV",},
                    {name=>"*/", type=>"PV", value=>'"CLOSE"', macro=>1},
                    {name=>"/*", type=>"PV", value=>'"OPEN"', macro=>1},
                    {name=>$pound, type=>"PV", value=>'"Sterling"', macro=>1},
                   );

{
  # Simple tests
  start_tests();
  my $parent_rfc1149 =
    'A Standard for the Transmission of IP Datagrams on Avian Carriers';
  # Test the code that generates 1 and 2 letter name comparisons.
  my %compass = (
                 N => 0, 'NE' => 45, E => 90, SE => 135,
                 S => 180, SW => 225, W => 270, NW => 315
                );

  my $header = << "EOT";
#define FIVE 5
#define OK6 "ok 6\\n"
#define OK7 1
#define FARTHING 0.25
#define NOT_ZERO 1
#define Yes 0
#define No 1
#define Undef 1
#define RFC1149 "$parent_rfc1149"
#undef NOTDEF
#define perl "rules"
EOT

  while (my ($point, $bearing) = each %compass) {
    $header .= "#define $point $bearing\n"
  }

  my @items = ("FIVE", {name=>"OK6", type=>"PV",},
               {name=>"OK7", type=>"PVN",
                value=>['"not ok 7\\n\\0ok 7\\n"', 15]},
               {name => "FARTHING", type=>"NV"},
               {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"},
               {name => "OPEN", type=>"PV", value=>'"/*"', macro=>1},
               {name => "CLOSE", type=>"PV", value=>'"*/"',
                macro=>["#if 1\n", "#endif\n"]},
               {name => "ANSWER", default=>["UV", 42]}, "NOTDEF",
               {name => "Yes", type=>"YES"},
               {name => "No", type=>"NO"},
               {name => "Undef", type=>"UNDEF"},
  # OK. It wasn't really designed to allow the creation of dual valued
  # constants.
  # It was more for INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
               {name=>"RFC1149", type=>"SV", value=>"sv_2mortal(temp_sv)",
                pre=>"SV *temp_sv = newSVpv(RFC1149, 0); "
                . "(void) SvUPGRADE(temp_sv,SVt_PVIV); SvIOK_on(temp_sv); "
                . "SvIV_set(temp_sv, 1149);"},
              );

  push @items, $_ foreach keys %compass;

  # Automatically compile the list of all the macro names, and make them
  # exported constants.
  my @export_names = map {(ref $_) ? $_->{name} : $_} @items;

  # Exporter::Heavy (currently) isn't able to export the last 3 of these:
  push @items, @common_items;

  # XXX there are hardwired still.
  my $test_body = <<'EOT';
# What follows goes to the temporary file.
# IV
my $five = FIVE;
if ($five == 5) {
  print "ok 5\n";
} else {
  print "not ok 5 # \$five\n";
}

# PV
print OK6;

# PVN containing embedded \0s
$_ = OK7;
s/.*\0//s;
print;

# NV
my $farthing = FARTHING;
if ($farthing == 0.25) {
  print "ok 8\n";
} else {
  print "not ok 8 # $farthing\n";
}

# UV
my $not_zero = NOT_ZERO;
if ($not_zero > 0 && $not_zero == ~0) {
  print "ok 9\n";
} else {
  print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
}

# Value includes a "*/" in an attempt to bust out of a C comment.
# Also tests custom cpp #if clauses
my $close = CLOSE;
if ($close eq '*/') {
  print "ok 10\n";
} else {
  print "not ok 10 # \$close='$close'\n";
}

# Default values if macro not defined.
my $answer = ANSWER;
if ($answer == 42) {
  print "ok 11\n";
} else {
  print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
}

# not defined macro
my $notdef = eval { NOTDEF; };
if (defined $notdef) {
  print "not ok 12 # \$notdef='$notdef'\n";
} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
  print "not ok 12 # \$@='$@'\n";
} else {
  print "ok 12\n";
}

# not a macro
my $notthere = eval { &ExtTest::NOTTHERE; };
if (defined $notthere) {
  print "not ok 13 # \$notthere='$notthere'\n";
} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
  chomp $@;
  print "not ok 13 # \$@='$@'\n";
} else {
  print "ok 13\n";
}

# Truth
my $yes = Yes;
if ($yes) {
  print "ok 14\n";
} else {
  print "not ok 14 # $yes='\$yes'\n";
}

# Falsehood
my $no = No;
if (defined $no and !$no) {
  print "ok 15\n";
} else {
  print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
}

# Undef
my $undef = Undef;
unless (defined $undef) {
  print "ok 16\n";
} else {
  print "not ok 16 # \$undef='$undef'\n";
}

# invalid macro (chosen to look like a mix up between No and SW)
$notdef = eval { &ExtTest::So };
if (defined $notdef) {
  print "not ok 17 # \$notdef='$notdef'\n";
} elsif ($@ !~ /^So is not a valid ExtTest macro/) {
  print "not ok 17 # \$@='$@'\n";
} else {
  print "ok 17\n";
}

# invalid defined macro
$notdef = eval { &ExtTest::EW };
if (defined $notdef) {
  print "not ok 18 # \$notdef='$notdef'\n";
} elsif ($@ !~ /^EW is not a valid ExtTest macro/) {
  print "not ok 18 # \$@='$@'\n";
} else {
  print "ok 18\n";
}

my %compass = (
EOT

while (my ($point, $bearing) = each %compass) {
  $test_body .= "'$point' => $bearing, "
}

$test_body .= <<'EOT';

);

my $fail;
while (my ($point, $bearing) = each %compass) {
  my $val = eval $point;
  if ($@) {
    print "# $point: \$@='$@'\n";
    $fail = 1;
  } elsif (!defined $bearing) {
    print "# $point: \$val=undef\n";
    $fail = 1;
  } elsif ($val != $bearing) {
    print "# $point: \$val=$val, not $bearing\n";
    $fail = 1;
  }
}
if ($fail) {
  print "not ok 19\n";
} else {
  print "ok 19\n";
}

EOT

$test_body .= <<"EOT";
my \$rfc1149 = RFC1149;
if (\$rfc1149 ne "$parent_rfc1149") {
  print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
} else {
  print "ok 20\n";
}

if (\$rfc1149 != 1149) {
  printf "not ok 21 # %d != 1149\n", \$rfc1149;
} else {
  print "ok 21\n";
}

EOT

$test_body .= <<'EOT';
# test macro=>1
my $open = OPEN;
if ($open eq '/*') {
  print "ok 22\n";
} else {
  print "not ok 22 # \$open='$open'\n";
}
EOT
$dummytest+=18;

  end_tests("Simple tests", \@items, \@export_names, $header, $test_body);
}

if ($do_utf_tests) {
  # utf8 tests
  start_tests();
  my ($inf, $pound_bytes, $pound_utf8);

  $inf = chr 0x221E;
  # Check that we can distiguish the pathological case of a string, and the
  # utf8 representation of that string.
  $pound_utf8 = $pound . '1';
  if ($better_than_56) {
    $pound_bytes = $pound_utf8;
    utf8::encode ($pound_bytes);
  } else {
    # Must have that "U*" to generate a zero length UTF string that forces
    # top bit set chars (such as the pound sign) into UTF8, so that the
    # unpack 'C*' then gets the byte form of the UTF8.
    $pound_bytes =  pack 'C*', unpack 'C*', $pound_utf8 . pack "U*";
  }

  my @items = (@common_items,
               {name=>$inf, type=>"PV", value=>'"Infinity"', macro=>1},
               {name=>$pound_utf8, type=>"PV", value=>'"1 Pound"', macro=>1},
               {name=>$pound_bytes, type=>"PV", value=>'"1 Pound (as bytes)"',
                macro=>1},
              );

=pod

The above set of names seems to produce a suitably bad set of compile
problems on a Unicode naive version of ExtUtils::Constant (ie 0.11):

nick at thinking-cap 15439-32-utf$ PERL_CORE=1 ./perl lib/ExtUtils/t/Constant.t
1..33
# perl=/stuff/perl5/15439-32-utf/perl
# ext-30370 being created...
Wide character in print at lib/ExtUtils/t/Constant.t line 140.
ok 1
ok 2
# make = 'make'
ExtTest.xs: In function `constant_1':
ExtTest.xs:80: warning: multi-character character constant
ExtTest.xs:80: warning: case value out of range
ok 3

=cut

# Grr `

  # Do this in 7 bit in case someone is testing with some settings that cause
  # 8 bit files incapable of storing this character.
  my @values
    = map {"'" . join (",", unpack "U*", $_ . pack "U*") . "'"}
      ($pound, $inf, $pound_bytes, $pound_utf8);
  # Values is a list of strings, such as ('194,163,49', '163,49')

  my $test_body .= "my \$test = $dummytest;\n";
  $dummytest += 7 * 3; # 3 tests for each of the 7 things:

  $test_body .= << 'EOT';

use utf8;
my $better_than_56 = $] > 5.007;

my ($pound, $inf, $pound_bytes, $pound_utf8) = map {eval "pack 'U*', $_"}
EOT

  $test_body .= join ",", @values;

  $test_body .= << 'EOT';
;

foreach (["perl", "rules", "rules"],
	 ["/*", "OPEN", "OPEN"],
	 ["*/", "CLOSE", "CLOSE"],
	 [$pound, 'Sterling', []],
         [$inf, 'Infinity', []],
	 [$pound_utf8, '1 Pound', '1 Pound (as bytes)'],
	 [$pound_bytes, '1 Pound (as bytes)', []],
        ) {
  # Flag an expected error with a reference for the expect string.
  my ($string, $expect, $expect_bytes) = @$_;
  (my $name = $string) =~ s/([^ -~])/sprintf '\x{%X}', ord $1/ges;
  print "# \"$name\" => \'$expect\'\n";
  # Try to force this to be bytes if possible.
  if ($better_than_56) {
    utf8::downgrade ($string, 1);
  } else {
    if ($string =~ tr/0-\377// == length $string) {
      # No chars outside range 0-255
      $string = pack 'C*', unpack 'U*', ($string . pack 'U*');
    }
  }
EOT

  $test_body .=  "my (\$error, \$got) = ${package}::constant (\$string);\n";

  $test_body .= <<'EOT';
  if ($error or $got ne $expect) {
    print "not ok $test # error '$error', got '$got'\n";
  } else {
    print "ok $test\n";
  }
  $test++;
  print "# Now upgrade '$name' to utf8\n";
  if ($better_than_56) {
    utf8::upgrade ($string);
  } else {
    $string = pack ('U*') . $string;
  }
EOT

  $test_body .=  "my (\$error, \$got) = ${package}::constant (\$string);\n";

  $test_body .= <<'EOT';
  if ($error or $got ne $expect) {
    print "not ok $test # error '$error', got '$got'\n";
  } else {
    print "ok $test\n";
  }
  $test++;
  if (defined $expect_bytes) {
    print "# And now with the utf8 byte sequence for name\n";
    # Try the encoded bytes.
    if ($better_than_56) {
      utf8::encode ($string);
    } else {
      $string = pack 'C*', unpack 'C*', $string . pack "U*";
    }
EOT

    $test_body .= "my (\$error, \$got) = ${package}::constant (\$string);\n";

    $test_body .= <<'EOT';
    if (ref $expect_bytes) {
      # Error expected.
      if ($error) {
        print "ok $test # error='$error' (as expected)\n";
      } else {
        print "not ok $test # expected error, got no error and '$got'\n";
      }
    } elsif ($got ne $expect_bytes) {
      print "not ok $test # error '$error', expect '$expect_bytes', got '$got'\n";
    } else {
      print "ok $test\n";
    }
    $test++;
  }
}
EOT

  end_tests("utf8 tests", \@items, [], "#define perl \"rules\"\n", $test_body);
}

# XXX I think that I should merge this into the utf8 test above.
sub explict_call_constant {
  my ($string, $expect) = @_;
  # This does assume simple strings suitable for ''
  my $test_body = <<"EOT";
{
  my (\$error, \$got) = ${package}::constant ('$string');\n;
EOT

  if (defined $expect) {
    # No error expected
    $test_body .= <<"EOT";
  if (\$error or \$got ne "$expect") {
    print "not ok $dummytest # error '\$error', expect '$expect', got '\$got'\n";
  } else {
    print "ok $dummytest\n";
    }
  }
EOT
  } else {
    # Error expected.
    $test_body .= <<"EOT";
  if (\$error) {
    print "ok $dummytest # error='\$error' (as expected)\n";
  } else {
    print "not ok $dummytest # expected error, got no error and '\$got'\n";
  }
EOT
  }
  $dummytest++;
  return $test_body . <<'EOT';
}
EOT
}

# Simple tests to verify bits of the switch generation system work.
sub simple {
  start_tests();
  # Deliberately leave $name in @_, so that it is indexed from 1.
  my ($name, @items) = @_;
  my $test_header;
  my $test_body = "my \$value;\n";
  foreach my $counter (1 .. $#_) {
    my $thisname = $_[$counter];
    $test_header .= "#define $thisname $counter\n";
    $test_body .= <<"EOT";
\$value = $thisname;
if (\$value == $counter) {
  print "ok $dummytest\n";
} else {
  print "not ok $dummytest # $thisname gave \$value\n";
}
EOT
    ++$dummytest;
    # Yes, the last time round the loop appends a z to the string.
    for my $i (0 .. length $thisname) {
      my $copyname = $thisname;
      substr ($copyname, $i, 1) = 'z';
      $test_body .= explict_call_constant ($copyname,
                                           $copyname eq $thisname
                                             ? $thisname : undef);
    }
  }
  # Ho. This seems to be buggy in 5.005_03:
  # # Now remove $name from @_:
  # shift @_;
  end_tests($name, \@items, \@items, $test_header, $test_body);
}

# Check that the memeq clauses work correctly when there isn't a switch
# statement to bump off a character
simple ("Singletons", "A", "AB", "ABC", "ABCD", "ABCDE");
# Check the three code.
simple ("Three start", qw(Bea kea Lea lea nea pea rea sea tea Wea yea Zea));
# There were 162 2 letter words in /usr/share/dict/words on FreeBSD 4.6, which
# I felt was rather too many. So I used words with 2 vowels.
simple ("Twos and three middle", qw(aa ae ai ea eu ie io oe era eta));
# Given the choice go for the end, else the earliest point
simple ("Three end and four symetry", qw(ean ear eat barb marm tart));


# Need this if the single test below is rolled into @tests :
# --$dummytest;
print "1..$dummytest\n";

write_and_run_extension @$_ foreach @tests;

# This was causing an assertion failure (a C<confess>ion)
# Any single byte > 128 should do it.
C_constant ($package, undef, undef, undef, undef, undef, chr 255);
print "ok $realtest\n"; $realtest++;

print STDERR "# You were running with \$keep_files set to $keep_files\n"
  if $keep_files;

--- NEW FILE: MM_Any.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use Test::More tests => 7;
BEGIN { use_ok('ExtUtils::MM') }


### OS Flavor methods

can_ok( 'MM', 'os_flavor', 'os_flavor_is' );

# Can't really know what the flavors are going to be, so we just
# make sure it returns something.
my @flavors = MM->os_flavor;
ok( @flavors,   'os_flavor() returned something' );

ok( MM->os_flavor_is($flavors[rand @flavors]), 
                                          'os_flavor_is() one flavor' );
ok( MM->os_flavor_is($flavors[rand @flavors], 'BogusOS'),
                                          '    many flavors' );
ok( !MM->os_flavor_is('BogusOS'),        '    wrong flavor' );
ok( !MM->os_flavor_is(),                 '    no flavor' );


--- NEW FILE: INST_PREFIX.t ---
#!/usr/bin/perl -w

# Wherein we ensure the INST_* and INSTALL* variables are set correctly
# when various PREFIX variables are set.
#
# Essentially, this test is a Makefile.PL.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 52;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;
use ExtUtils::MakeMaker;
use File::Spec;
use TieOut;
use ExtUtils::MakeMaker::Config;

my $Is_VMS = $^O eq 'VMS';

chdir 't';

perl_lib;

$| = 1;

my $Makefile = makefile_name;
my $Curdir = File::Spec->curdir;
my $Updir  = File::Spec->updir;

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) ||
  diag("chdir failed: $!");

my $stdout = tie *STDOUT, 'TieOut' or die;

my $mm = WriteMakefile(
    NAME          => 'Big::Dummy',
    VERSION_FROM  => 'lib/Big/Dummy.pm',
    PREREQ_PM     => {},
    PERL_CORE     => $ENV{PERL_CORE},
);

like( $stdout->read, qr{
                        Writing\ $Makefile\ for\ Big::Liar\n
                        Big::Liar's\ vars\n
                        INST_LIB\ =\ \S+\n
                        INST_ARCHLIB\ =\ \S+\n
                        Writing\ $Makefile\ for\ Big::Dummy\n
}x );

is( $mm->{PREFIX}, '$(SITEPREFIX)', 'PREFIX set based on INSTALLDIRS' );

isa_ok( $mm, 'ExtUtils::MakeMaker' );

is( $mm->{NAME}, 'Big::Dummy',  'NAME' );
is( $mm->{VERSION}, 0.01,            'VERSION' );

foreach my $prefix (qw(PREFIX PERLPREFIX SITEPREFIX VENDORPREFIX)) {
    unlike( $mm->{$prefix}, qr/\$\(PREFIX\)/ );
}


my $PREFIX = File::Spec->catdir('foo', 'bar');
$mm = WriteMakefile(
    NAME          => 'Big::Dummy',
    VERSION_FROM  => 'lib/Big/Dummy.pm',
    PREREQ_PM     => {},
    PERL_CORE     => $ENV{PERL_CORE},
    PREFIX        => $PREFIX,
);
like( $stdout->read, qr{
                        Writing\ $Makefile\ for\ Big::Liar\n
                        Big::Liar's\ vars\n
                        INST_LIB\ =\ \S+\n
                        INST_ARCHLIB\ =\ \S+\n
                        Writing\ $Makefile\ for\ Big::Dummy\n
}x );
undef $stdout;
untie *STDOUT;

is( $mm->{PREFIX}, $PREFIX,   'PREFIX' );

foreach my $prefix (qw(PERLPREFIX SITEPREFIX VENDORPREFIX)) {
    is( $mm->{$prefix}, '$(PREFIX)', "\$(PREFIX) overrides $prefix" );
}

is( !!$mm->{PERL_CORE}, !!$ENV{PERL_CORE}, 'PERL_CORE' );

my($perl_src, $mm_perl_src);
if( $ENV{PERL_CORE} ) {
    $perl_src = File::Spec->catdir($Updir, $Updir);
    $perl_src = File::Spec->canonpath($perl_src);
    $mm_perl_src = File::Spec->canonpath($mm->{PERL_SRC});
}
else {
    $mm_perl_src = $mm->{PERL_SRC};
}

is( $mm_perl_src, $perl_src,     'PERL_SRC' );


# Every INSTALL* variable must start with some PREFIX.
my %Install_Vars = (
 PERL   => [qw(archlib    privlib   bin       man1dir       man3dir   script)],
 SITE   => [qw(sitearch   sitelib   sitebin   siteman1dir   siteman3dir)],
 VENDOR => [qw(vendorarch vendorlib vendorbin vendorman1dir vendorman3dir)]
);

while( my($type, $vars) = each %Install_Vars) {
    SKIP: {
        skip "VMS must expand macros in INSTALL* vars", scalar @$vars 
          if $Is_VMS;    
        skip '$Config{usevendorprefix} not set', scalar @$vars
          if $type eq 'VENDOR' and !$Config{usevendorprefix};

        foreach my $var (@$vars) {
            my $installvar = "install$var";
            my $prefix = '$('.$type.'PREFIX)';

            SKIP: {
                skip uc($installvar).' set to another INSTALL variable', 1
                  if $mm->{uc $installvar} =~ /^\$\(INSTALL.*\)$/;

                # support for man page skipping
                $prefix = 'none' if $type eq 'PERL' && 
                                    $var =~ /man/ && 
                                    !$Config{$installvar};
                like( $mm->{uc $installvar}, qr/^\Q$prefix\E/, 
                      "$prefix + $var" );
            }
        }
    }
}

# Check that when installman*dir isn't set in Config no man pages
# are generated.
{
    _set_config(installman1dir => '');
    _set_config(installman3dir => '');

    my $wibble = File::Spec->catdir(qw(wibble and such));
    my $stdout = tie *STDOUT, 'TieOut' or die;
    my $mm = WriteMakefile(
                           NAME          => 'Big::Dummy',
                           VERSION_FROM  => 'lib/Big/Dummy.pm',
                           PREREQ_PM     => {},
                           PERL_CORE     => $ENV{PERL_CORE},
                           PREFIX        => $PREFIX,
                           INSTALLMAN1DIR=> $wibble,
                          );

    is( $mm->{INSTALLMAN1DIR}, $wibble );
    is( $mm->{INSTALLMAN3DIR}, 'none'  );
}

# Check that when installvendorman*dir is set in Config it is honored
# [rt.cpan.org 2949]
{
    _set_config(installvendorman1dir => File::Spec->catdir('foo','bar') );
    _set_config(installvendorman3dir => '' );
    _set_config(usevendorprefix => 1 );
    _set_config(vendorprefixexp => 'something' );

    my $stdout = tie *STDOUT, 'TieOut' or die;
    my $mm = WriteMakefile(
                   NAME          => 'Big::Dummy',
                   VERSION_FROM  => 'lib/Big/Dummy.pm',
                   PREREQ_PM     => {},
                   PERL_CORE     => $ENV{PERL_CORE},

                   # In case the local installation doesn't have man pages.
                   INSTALLMAN1DIR=> 'foo/bar/baz',
                   INSTALLMAN3DIR=> 'foo/bar/baz',
                  );

    is( $mm->{INSTALLVENDORMAN1DIR}, File::Spec->catdir('foo','bar'), 
                      'installvendorman1dir (in %Config) not modified' );
    isnt( $mm->{INSTALLVENDORMAN3DIR}, '', 
                      'installvendorman3dir (not in %Config) set'  );
}

# Check that when installsiteman*dir isn't set in Config it falls back
# to installman*dir
{
    _set_config(installman1dir => File::Spec->catdir('foo', 'bar') );
    _set_config(installman3dir => File::Spec->catdir('foo', 'baz') );
    _set_config(installsiteman1dir => '' );
    _set_config(installsiteman3dir => '' );
    _set_config(installvendorman1dir => '' );
    _set_config(installvendorman3dir => '' );
    _set_config(usevendorprefix => 'define' );
    _set_config(vendorprefixexp => 'something' );

    my $wibble = File::Spec->catdir(qw(wibble and such));
    my $stdout = tie *STDOUT, 'TieOut' or die;
    my $mm = WriteMakefile(
                           NAME          => 'Big::Dummy',
                           VERSION_FROM  => 'lib/Big/Dummy.pm',
                           PERL_CORE     => $ENV{PERL_CORE},
                          );

    is( $mm->{INSTALLMAN1DIR}, File::Spec->catdir('foo', 'bar') );
    is( $mm->{INSTALLMAN3DIR}, File::Spec->catdir('foo', 'baz') );
    SKIP: {
        skip "VMS must expand macros in INSTALL* vars", 4 if $Is_VMS;

        is( $mm->{INSTALLSITEMAN1DIR},   '$(INSTALLMAN1DIR)' );
        is( $mm->{INSTALLSITEMAN3DIR},   '$(INSTALLMAN3DIR)' );
        is( $mm->{INSTALLVENDORMAN1DIR}, '$(INSTALLMAN1DIR)' );
        is( $mm->{INSTALLVENDORMAN3DIR}, '$(INSTALLMAN3DIR)' );
    }
}


# Check that when usevendoprefix and installvendorman*dir aren't set in 
# Config it leaves them unset.
{
    _set_config(installman1dir => File::Spec->catdir('foo', 'bar') );
    _set_config(installman3dir => File::Spec->catdir('foo', 'baz') );
    _set_config(installsiteman1dir => '' );
    _set_config(installsiteman3dir => '' );
    _set_config(installvendorman1dir => '' );
    _set_config(installvendorman3dir => '' );
    _set_config(usevendorprefix => '' );
    _set_config(vendorprefixexp => '' );

    my $wibble = File::Spec->catdir(qw(wibble and such));
    my $stdout = tie *STDOUT, 'TieOut' or die;
    my $mm = WriteMakefile(
                           NAME          => 'Big::Dummy',
                           VERSION_FROM  => 'lib/Big/Dummy.pm',
                           PERL_CORE     => $ENV{PERL_CORE},
                          );

    is( $mm->{INSTALLMAN1DIR}, File::Spec->catdir('foo', 'bar') );
    is( $mm->{INSTALLMAN3DIR}, File::Spec->catdir('foo', 'baz') );
    SKIP: {
        skip "VMS must expand macros in INSTALL* vars", 2 if $Is_VMS;
        is( $mm->{INSTALLSITEMAN1DIR},   '$(INSTALLMAN1DIR)' );
        is( $mm->{INSTALLSITEMAN3DIR},   '$(INSTALLMAN3DIR)' );
    }
    is( $mm->{INSTALLVENDORMAN1DIR}, '' );
    is( $mm->{INSTALLVENDORMAN3DIR}, '' );
}


sub _set_config {
    my($k,$v) = @_;
    (my $k_no_install = $k) =~ s/^install//i;
    $Config{$k} = $v;

    # Because VMS's config has traditionally been underpopulated, it will
    # fall back to the install-less versions in desperation.
    $Config{$k_no_install} = $v if $Is_VMS;
    return;
}

--- NEW FILE: bytes.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 4;

use_ok('ExtUtils::MakeMaker::bytes');

SKIP: {
    skip "bytes.pm appeared in 5.6", 3 if $] < 5.006;

    my $chr = chr(400);
    is( length $chr, 1 );

    {
        use ExtUtils::MakeMaker::bytes;
        is( length $chr, 2, 'byte.pm in effect' );
    }

    is( length $chr, 1, '  score is lexical' );
}

--- NEW FILE: Mkbootstrap.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib/');
    }
    else {
        unshift @INC, 't/lib/';
    }
}
chdir 't';

use vars qw( $required );
use Test::More tests => 18;

BEGIN { use_ok( 'ExtUtils::Mkbootstrap' ) }

# Mkbootstrap makes a backup copy of "$_[0].bs" if it exists and is non-zero
my $file_is_ready;
local *OUT;
if (open(OUT, '>mkboot.bs')) {
	$file_is_ready = 1;
	print OUT 'meaningless text';
	close OUT;
}

SKIP: {
	skip("could not make dummy .bs file: $!", 2) unless $file_is_ready;

	Mkbootstrap('mkboot');
	ok( -s 'mkboot.bso', 'Mkbootstrap should backup the .bs file' );
	local *IN;
	if (open(IN, 'mkboot.bso')) {
		chomp ($file_is_ready = <IN>);
		close IN;
	}

	is( $file_is_ready, 'meaningless text', 'backup should be a perfect copy' );
}


# if it doesn't exist or is zero bytes in size, it won't be backed up
Mkbootstrap('fakeboot');
ok( !( -f 'fakeboot.bso' ), 'Mkbootstrap should not backup an empty file' );

use TieOut;
my $out = tie *STDOUT, 'TieOut';

# with $Verbose set, it should print status messages about libraries
$ExtUtils::Mkbootstrap::Verbose = 1;
Mkbootstrap('');
is( $out->read, "\tbsloadlibs=\n", 'should report libraries in Verbose mode' );

Mkbootstrap('', 'foo');
like( $out->read, qr/bsloadlibs=foo/, 'should still report libraries' );


# if ${_[0]}_BS exists, require it
$file_is_ready = open(OUT, '>boot_BS');

SKIP: {
	skip("cannot open boot_BS for writing: $!", 1) unless $file_is_ready;

	print OUT '$main::required = 1';
	close OUT;
	Mkbootstrap('boot');

	ok( $required, 'baseext_BS file should be require()d' );
}


# if there are any arguments, open a file named baseext.bs
$file_is_ready = open(OUT, '>dasboot.bs');

SKIP: {
	skip("cannot make dasboot.bs: $!", 5) unless $file_is_ready;

	# if it can't be opened for writing, we want to prove that it'll die
	close OUT;
	chmod 0444, 'dasboot.bs';

	SKIP: {
	    skip("cannot write readonly files", 1) if -w 'dasboot.bs'; 

	    eval{ Mkbootstrap('dasboot', 1) };
	    like( $@, qr/Unable to open dasboot\.bs/, 'should die given bad filename' );
	}

	# now put it back like it was
	chmod 0777, 'dasboot.bs';
	eval{ Mkbootstrap('dasboot', 'myarg') };
	is( $@, '', 'should not die, given good filename' );

	# red and reed (a visual pun makes tests worth reading)
	my $read = $out->read();
	like( $read, qr/Writing dasboot.bs/, 'should print status' );
	like( $read, qr/containing: my/, 'should print verbose status on request' );

	# now be tricky, and set the status for the next skip block
	$file_is_ready = open(IN, 'dasboot.bs');
	ok( $file_is_ready, 'should have written a new .bs file' );
}


SKIP: {
	skip("cannot read .bs file: $!", 2) unless $file_is_ready;

	my $file = do { local $/ = <IN> };

	# filename should be in header
	like( $file, qr/# dasboot DynaLoader/, 'file should have boilerplate' );

	# should print arguments within this array
	like( $file, qr/qw\(myarg\);/, 'should have written array to file' );
}


# overwrite this file (may whack portability, but the name's too good to waste)
$file_is_ready = open(OUT, '>dasboot.bs');

SKIP: {
	skip("cannot make dasboot.bs again: $!", 1) unless $file_is_ready;
	close OUT;

	# if $DynaLoader::bscode is set, write its contents to the file
    local $DynaLoader::bscode;
	$DynaLoader::bscode = 'Wall';
	$ExtUtils::Mkbootstrap::Verbose = 0;
	
	# if arguments contain '-l' or '-L' or '-R' print dl_findfile message
	eval{ Mkbootstrap('dasboot', '-Larry') };
	is( $@, '', 'should be able to open a file again');

	$file_is_ready = open(IN, 'dasboot.bs');
}

SKIP: {
	skip("cannot open dasboot.bs for reading: $!", 3) unless $file_is_ready;

	my $file = do { local $/ = <IN> };
	is( $out->read, "Writing dasboot.bs\n", 'should hush without Verbose set' );

	# and find our hidden tribute to a fine example
	like( $file, qr/dl_findfile.+Larry/s, 'should load libraries if needed' );
	like( $file, qr/Wall\n1;\n/ms, 'should write $DynaLoader::bscode if set' );
}

close IN;
close OUT;

END {
	# clean things up, even on VMS
	1 while unlink(qw( mkboot.bso boot_BS dasboot.bs .bs ));
}

--- NEW FILE: writemakefile_args.t ---
#!/usr/bin/perl -w

# This is a test of the verification of the arguments to
# WriteMakefile.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 16;

use TieOut;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;

use ExtUtils::MakeMaker;

chdir 't';

perl_lib();

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) ||
  diag("chdir failed: $!");

{
    ok( my $stdout = tie *STDOUT, 'TieOut' );
    my $warnings = '';
    local $SIG{__WARN__} = sub {
        $warnings .= join '', @_;
    };

    my $mm;

    eval {
        $mm = WriteMakefile(
            NAME            => 'Big::Dummy',
            VERSION_FROM    => 'lib/Big/Dummy.pm',
            MAN3PODS        => ' ', # common mistake
        );
    };

    is( $warnings, <<VERIFY );
WARNING: MAN3PODS takes a hash reference not a string/number.
         Please inform the author.
VERIFY

    $warnings = '';
    eval {
        $mm = WriteMakefile(
            NAME            => 'Big::Dummy',
            VERSION_FROM    => 'lib/Big/Dummy.pm',
            AUTHOR          => sub {},
        );
    };

    is( $warnings, <<VERIFY );
WARNING: AUTHOR takes a string/number not a code reference.
         Please inform the author.
VERIFY

    # LIBS accepts *both* a string or an array ref.  The first cut of
    # our verification did not take this into account.
    $warnings = '';
    $mm = WriteMakefile(
        NAME            => 'Big::Dummy',
        VERSION_FROM    => 'lib/Big/Dummy.pm',
        LIBS            => '-lwibble -lwobble',
    );

    # We'll get warnings about the bogus libs, that's ok.
    unlike( $warnings, qr/WARNING: .* takes/ );
    is_deeply( $mm->{LIBS}, ['-lwibble -lwobble'] );

    $warnings = '';
    $mm = WriteMakefile(
        NAME            => 'Big::Dummy',
        VERSION_FROM    => 'lib/Big/Dummy.pm',
        LIBS            => ['-lwibble', '-lwobble'],
    );

    # We'll get warnings about the bogus libs, that's ok.
    unlike( $warnings, qr/WARNING: .* takes/ );
    is_deeply( $mm->{LIBS}, ['-lwibble', '-lwobble'] );

    $warnings = '';
    eval {
        $mm = WriteMakefile(
            NAME            => 'Big::Dummy',
            VERSION_FROM    => 'lib/Big/Dummy.pm',
            LIBS            => { wibble => "wobble" },
        );
    };

    # We'll get warnings about the bogus libs, that's ok.
    like( $warnings, qr{^WARNING: LIBS takes a array reference or string/number not a hash reference}m );


    $warnings = '';
    $mm = WriteMakefile(
        NAME            => 'Big::Dummy',
        WIBBLE          => 'something',
        wump            => { foo => 42 },
    );

    like( $warnings, qr{^WARNING: WIBBLE is not a known parameter.\n}m );
    like( $warnings, qr{^WARNING: wump is not a known parameter.\n}m );

    is( $mm->{WIBBLE}, 'something' );
    is_deeply( $mm->{wump}, { foo => 42 } );
}

--- NEW FILE: parse_version.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use Test::More tests => 10;
use ExtUtils::MakeMaker;

my %versions = ('$VERSION = 0.02'   => 0.02,
                '$VERSION = 0.0'    => 0.0,
                '$VERSION = -1.0'   => -1.0,
                '$VERSION = undef'  => 'undef',
                '$wibble  = 1.0'    => 'undef',
               );

while( my($code, $expect) = each %versions ) {
    open(FILE, ">VERSION.tmp") || die $!;
    print FILE "$code\n";
    close FILE;

    $_ = 'foo';
    is( MM->parse_version('VERSION.tmp'), $expect, $code );
    is( $_, 'foo', '$_ not leaked by parse_version' );

    unlink "VERSION.tmp";
}

--- NEW FILE: prefixify.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More;

if( $^O eq 'VMS' ) {
    plan skip_all => 'prefixify works differently on VMS';
}
else {
    plan tests => 3;
}
use ExtUtils::MakeMaker::Config;
use File::Spec;
use ExtUtils::MM;

my $Is_Dosish = $^O =~ /^(dos|MSWin32)$/;

my $mm = bless {}, 'MM';

my $default = File::Spec->catdir(qw(this that));

$mm->prefixify('installbin', 'wibble', 'something', $default);
is( $mm->{INSTALLBIN}, $Config{installbin},
                                            'prefixify w/defaults');

$mm->{ARGS}{PREFIX} = 'foo';
$mm->prefixify('installbin', 'wibble', 'something', $default);
is( $mm->{INSTALLBIN}, File::Spec->catdir('something', $default),
                                            'prefixify w/defaults and PREFIX');

SKIP: {
    skip "Test for DOSish prefixification", 1 unless $Is_Dosish;

    $Config{wibble} = 'C:\opt\perl\wibble';
    $mm->prefixify('wibble', 'C:\opt\perl', 'C:\yarrow');

    is( $mm->{WIBBLE}, 'C:\yarrow\wibble',  'prefixify Win32 paths' );
}

--- NEW FILE: oneliner.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

chdir 't';

use MakeMaker::Test::Utils;
use Test::More tests => 6;
use File::Spec;

my $TB = Test::More->builder;

BEGIN { use_ok('ExtUtils::MM') }

my $mm = bless { NAME => "Foo" }, 'MM';
isa_ok($mm, 'ExtUtils::MakeMaker');
isa_ok($mm, 'ExtUtils::MM_Any');


sub try_oneliner {
    my($code, $switches, $expect, $name) = @_;
    my $cmd = $mm->oneliner($code, $switches);
    $cmd =~ s{\$\(ABSPERLRUN\)}{$^X};

    # VMS likes to put newlines at the end of commands if there isn't
    # one already.
    $expect =~ s/([^\n])\z/$1\n/ if $^O eq 'VMS';

    $TB->is_eq(scalar `$cmd`, $expect, $name) || $TB->diag("oneliner:\n$cmd");
}

# Lets see how it deals with quotes.
try_oneliner(q{print "foo'o", ' bar"ar'}, [],  q{foo'o bar"ar},  'quotes');

# How about dollar signs?
try_oneliner(q{$PATH = 'foo'; print $PATH},[], q{foo},   'dollar signs' );

# switches?
try_oneliner(q{print 'foo'}, ['-l'],           "foo\n",       'switches' );

# XXX gotta rethink the newline test.  The Makefile does newline
# escaping, then the shell.


--- NEW FILE: prereq_print.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Config;

use Test::More;

unless( eval { require Data::Dumper } ) {
    plan skip_all => 'Data::Dumper not available';
}

plan tests => 11;


use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;

# 'make disttest' sets a bunch of environment variables which interfere
# with our testing.
delete @ENV{qw(PREFIX LIB MAKEFLAGS)};

my $Perl = which_perl();
my $Makefile = makefile_name();
my $Is_VMS = $^O eq 'VMS';

chdir 't';
perl_lib;

$| = 1;

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) ||
  diag("chdir failed: $!");

unlink $Makefile;
my $prereq_out = run(qq{$Perl Makefile.PL "PREREQ_PRINT=1"});
ok( !-r $Makefile, "PREREQ_PRINT produces no $Makefile" );
is( $?, 0,         '  exited normally' );
{
    package _Prereq::Print;
    no strict;
    $PREREQ_PM = undef;  # shut up "used only once" warning.
    eval $prereq_out;
    ::is_deeply( $PREREQ_PM, { strict => 0 }, 'prereqs dumped' );
    ::is( $@, '',                             '  without error' );
}


$prereq_out = run(qq{$Perl Makefile.PL "PRINT_PREREQ=1"});
ok( !-r $Makefile, "PRINT_PREREQ produces no $Makefile" );
is( $?, 0,         '  exited normally' );
::like( $prereq_out, qr/^perl\(strict\) \s* >= \s* 0 \s*$/x, 
                                                      'prereqs dumped' );


# Currently a bug.
#my $prereq_out = run(qq{$Perl Makefile.PL "PREREQ_PRINT=0"});
#ok( -r $Makefile, "PREREQ_PRINT=0 produces a $Makefile" );
#is( $?, 0,         '  exited normally' );
#unlink $Makefile;

# Currently a bug.
#my $prereq_out = run(qq{$Perl Makefile.PL "PRINT_PREREQ=1"});
#ok( -r $Makefile, "PRINT_PREREQ=0 produces a $Makefile" );
#is( $?, 0,         '  exited normally' );
#unlink $Makefile;

--- NEW FILE: backwards.t ---
#!/usr/bin/perl -w

# This is a test for all the odd little backwards compatible things
# MakeMaker has to support.  And we do mean backwards.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 2;

require ExtUtils::MakeMaker;

# CPAN.pm wants MM.
can_ok('MM', 'new');

# Pre 5.8 ExtUtils::Embed wants MY.
can_ok('MY', 'catdir');

--- NEW FILE: MM_BeOS.t ---
#!/usr/bin/perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use Test::More;

BEGIN {
	if ($^O =~ /beos/i) {
		plan tests => 4;
	} else {
		plan skip_all => 'This is not BeOS';
	}
}

use Config;
use File::Spec;
use File::Basename;

# tels - Taken from MM_Win32.t - I must not understand why this works, right?
# Does this mimic ExtUtils::MakeMaker ok?
{
    @MM::ISA = qw(
        ExtUtils::MM_Unix 
        ExtUtils::Liblist::Kid 
        ExtUtils::MakeMaker
    );
    # MM package faked up by messy MI entanglement
    package MM;
    sub DESTROY {}
}

require_ok( 'ExtUtils::MM_BeOS' );

my $MM = bless { NAME => "Foo" }, 'MM';

# init_linker
{
    my $libperl = File::Spec->catfile('$(PERL_INC)', 
                                      $Config{libperl} || 'libperl.a' );
    my $export  = '';
    my $after   = '';
    $MM->init_linker;

    is( $MM->{PERL_ARCHIVE},        $libperl,   'PERL_ARCHIVE' );
    is( $MM->{PERL_ARCHIVE_AFTER},  $after,     'PERL_ARCHIVE_AFTER' );
    is( $MM->{EXPORT_LIST},         $export,    'EXPORT_LIST' );
}

--- NEW FILE: VERSION_FROM.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

chdir 't';

use strict;
use Test::More tests => 1;
use MakeMaker::Test::Utils;
use ExtUtils::MakeMaker;
use TieOut;
use File::Path;

perl_lib();

mkdir('Odd-Version', 0777);
END { chdir File::Spec->updir;  rmtree 'Odd-Version' }
chdir 'Odd-Version';

open(MPL, ">Version") || die $!;
print MPL "\$VERSION = 0\n";
close MPL;
END { unlink 'Version' }

my $stdout = tie *STDOUT, 'TieOut' or die;
my $mm = WriteMakefile(
    NAME         => 'Version',
    VERSION_FROM => 'Version'
);

is( $mm->{VERSION}, 0, 'VERSION_FROM when $VERSION = 0' );

--- NEW FILE: Install.t ---
#!/usr/bin/perl -w

# Test ExtUtils::Install.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        @INC = ('../../lib', '../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use TieOut;
use File::Path;
use File::Spec;

use Test::More tests => 32;

use MakeMaker::Test::Setup::BFD;

BEGIN { use_ok('ExtUtils::Install') }

# Check exports.
foreach my $func (qw(install uninstall pm_to_blib install_default)) {
    can_ok(__PACKAGE__, $func);
}


ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

chdir 'Big-Dummy';

my $stdout = tie *STDOUT, 'TieOut';
pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
            'blib/lib/auto'
          );
END { rmtree 'blib' }

ok( -d 'blib/lib',              'pm_to_blib created blib dir' );
ok( -r 'blib/lib/Big/Dummy.pm', '  copied .pm file' );
ok( -r 'blib/lib/auto',         '  created autosplit dir' );
is( $stdout->read, "cp lib/Big/Dummy.pm blib/lib/Big/Dummy.pm\n" );

pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
            'blib/lib/auto'
          );
ok( -d 'blib/lib',              'second run, blib dir still there' );
ok( -r 'blib/lib/Big/Dummy.pm', '  .pm file still there' );
ok( -r 'blib/lib/auto',         '  autosplit still there' );
is( $stdout->read, "Skip blib/lib/Big/Dummy.pm (unchanged)\n" );

install( { 'blib/lib' => 'install-test/lib/perl',
           read   => 'install-test/packlist',
           write  => 'install-test/packlist'
         },
       0, 1);
ok( ! -d 'install-test/lib/perl',        'install made dir (dry run)');
ok( ! -r 'install-test/lib/perl/Big/Dummy.pm',
                                         '  .pm file installed (dry run)');
ok( ! -r 'install-test/packlist',        '  packlist exists (dry run)');

install( { 'blib/lib' => 'install-test/lib/perl',
           read   => 'install-test/packlist',
           write  => 'install-test/packlist'
         } );
ok( -d 'install-test/lib/perl',                 'install made dir' );
ok( -r 'install-test/lib/perl/Big/Dummy.pm',    '  .pm file installed' );
ok( -r 'install-test/packlist',                 '  packlist exists' );

open(PACKLIST, 'install-test/packlist' );
my %packlist = map { chomp;  ($_ => 1) } <PACKLIST>;
close PACKLIST;

# On case-insensitive filesystems (ie. VMS), the keys of the packlist might 
# be lowercase. :(
my $native_dummy = File::Spec->catfile(qw(install-test lib perl Big Dummy.pm));
is( keys %packlist, 1 );
is( lc((keys %packlist)[0]), lc $native_dummy, 'packlist written' );


# Test UNINST=1 preserving same versions in other dirs.
install( { 'blib/lib' => 'install-test/other_lib/perl',
           read   => 'install-test/packlist',
           write  => 'install-test/packlist'
         },
       0, 0, 1);
ok( -d 'install-test/other_lib/perl',        'install made other dir' );
ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
ok( -r 'install-test/packlist',              '  packlist exists' );
ok( -r 'install-test/lib/perl/Big/Dummy.pm', '  UNINST=1 preserved same' );



# Test UNINST=1 removing other versions in other dirs.
chmod 0644, 'blib/lib/Big/Dummy.pm' or die $!;
open(DUMMY, ">>blib/lib/Big/Dummy.pm") or die $!;
print DUMMY "Extra stuff\n";
close DUMMY;

{
  local @INC = ('install-test/lib/perl');
  local $ENV{PERL5LIB} = '';
  install( { 'blib/lib' => 'install-test/other_lib/perl',
           read   => 'install-test/packlist',
           write  => 'install-test/packlist'
         },
       0, 0, 1);
  ok( -d 'install-test/other_lib/perl',        'install made other dir' );
  ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
  ok( -r 'install-test/packlist',              '  packlist exists' );
  ok( !-r 'install-test/lib/perl/Big/Dummy.pm',
                                             '  UNINST=1 removed different' );
}

--- NEW FILE: INST.t ---
#!/usr/bin/perl -w

# Wherein we ensure the INST_* and INSTALL* variables are set correctly
# in a default Makefile.PL run
#
# Essentially, this test is a Makefile.PL.

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = ('../lib', 'lib');
    }
    else {
        unshift @INC, 't/lib';
    }
}

use strict;
use Test::More tests => 26;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;
use ExtUtils::MakeMaker;
use File::Spec;
use TieOut;
use Config;

chdir 't';

perl_lib;

$| = 1;

my $Makefile = makefile_name;
my $Curdir = File::Spec->curdir;
my $Updir  = File::Spec->updir;

ok( setup_recurs(), 'setup' );
END {
    ok( chdir File::Spec->updir );
    ok( teardown_recurs(), 'teardown' );
}

ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) ||
  diag("chdir failed: $!");

my $stdout = tie *STDOUT, 'TieOut' or die;
my $mm = WriteMakefile(
    NAME          => 'Big::Dummy',
    VERSION_FROM  => 'lib/Big/Dummy.pm',
    PREREQ_PM     => {},
    PERL_CORE     => $ENV{PERL_CORE},
);
like( $stdout->read, qr{
                        Writing\ $Makefile\ for\ Big::Liar\n
                        Big::Liar's\ vars\n
                        INST_LIB\ =\ \S+\n
                        INST_ARCHLIB\ =\ \S+\n
                        Writing\ $Makefile\ for\ Big::Dummy\n
}x );
undef $stdout;
untie *STDOUT;

isa_ok( $mm, 'ExtUtils::MakeMaker' );

is( $mm->{NAME}, 'Big::Dummy',  'NAME' );
is( $mm->{VERSION}, 0.01,            'VERSION' );

my $config_prefix = $Config{installprefixexp} || $Config{installprefix} ||
                    $Config{prefixexp}        || $Config{prefix};
is( $mm->{PERLPREFIX}, $config_prefix,   'PERLPREFIX' );

is( !!$mm->{PERL_CORE}, !!$ENV{PERL_CORE}, 'PERL_CORE' );

my($perl_src, $mm_perl_src);
if( $ENV{PERL_CORE} ) {
    $perl_src = File::Spec->catdir($Updir, $Updir);
    $perl_src = File::Spec->canonpath($perl_src);
    $mm_perl_src = File::Spec->canonpath($mm->{PERL_SRC});
}
else {
    $mm_perl_src = $mm->{PERL_SRC};
}

is( $mm_perl_src, $perl_src,     'PERL_SRC' );


# PERM_*
is( $mm->{PERM_RW},  644,    'PERM_RW' );
is( $mm->{PERM_RWX}, 755,    'PERM_RWX' );


# INST_*
is( $mm->{INST_ARCHLIB}, 
    $mm->{PERL_CORE} ? $mm->{PERL_ARCHLIB}
                     : File::Spec->catdir($Curdir, 'blib', 'arch'),
                                     'INST_ARCHLIB');
is( $mm->{INST_BIN},     File::Spec->catdir($Curdir, 'blib', 'bin'),
                                     'INST_BIN' );

is( keys %{$mm->{CHILDREN}}, 1 );
my($child_pack) = keys %{$mm->{CHILDREN}};
my $c_mm = $mm->{CHILDREN}{$child_pack};
is( $c_mm->{INST_ARCHLIB}, 
    $c_mm->{PERL_CORE} ? $c_mm->{PERL_ARCHLIB}
                       : File::Spec->catdir($Updir, 'blib', 'arch'),
                                     'CHILD INST_ARCHLIB');
is( $c_mm->{INST_BIN},     File::Spec->catdir($Updir, 'blib', 'bin'),
                                     'CHILD INST_BIN' );


my $inst_lib = File::Spec->catdir($Curdir, 'blib', 'lib');
is( $mm->{INST_LIB}, 
    $mm->{PERL_CORE} ? $mm->{PERL_LIB} : $inst_lib,     'INST_LIB' );


# INSTALL*
is( $mm->{INSTALLDIRS}, 'site',     'INSTALLDIRS' );



# Make sure the INSTALL*MAN*DIR variables work.  We forgot them
# at one point.
$stdout = tie *STDOUT, 'TieOut' or die;
$mm = WriteMakefile(
    NAME          => 'Big::Dummy',
    VERSION_FROM  => 'lib/Big/Dummy.pm',
    PERL_CORE     => $ENV{PERL_CORE},
    INSTALLMAN1DIR       => 'none',
    INSTALLSITEMAN3DIR   => 'none',
    INSTALLVENDORMAN1DIR => 'none',
    INST_MAN1DIR         => 'none',
);
like( $stdout->read, qr{
                        Writing\ $Makefile\ for\ Big::Liar\n
                        Big::Liar's\ vars\n
                        INST_LIB\ =\ \S+\n
                        INST_ARCHLIB\ =\ \S+\n
                        Writing\ $Makefile\ for\ Big::Dummy\n
}x );
undef $stdout;
untie *STDOUT;

isa_ok( $mm, 'ExtUtils::MakeMaker' );

is  ( $mm->{INSTALLMAN1DIR},        'none' );
is  ( $mm->{INSTALLSITEMAN3DIR},    'none' );
is  ( $mm->{INSTALLVENDORMAN1DIR},  'none' );
is  ( $mm->{INST_MAN1DIR},          'none' );

--- NEW FILE: MM_Win32.t ---
#!/usr/bin/perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

use strict;
use Test::More;

BEGIN {
	if ($^O =~ /MSWin32/i) {
		plan tests => 41;
	} else {
		plan skip_all => 'This is not Win32';
	}
}

use Config;
use File::Spec;
use File::Basename;
use ExtUtils::MM;

require_ok( 'ExtUtils::MM_Win32' );

# Dummy MM object until we have a real MM init method.
my $MM = bless {
                DIR     => [],
                NOECHO  => '@',
                XS      => {},
                MAKEFILE => 'Makefile',
                RM_RF   => 'rm -rf',
                MV      => 'mv',
               }, 'MM';


# replace_manpage_separator() => tr|/|.|s ?
{
    my $man = 'a/path/to//something';
    ( my $replaced = $man ) =~ tr|/|.|s;
    is( $MM->replace_manpage_separator( $man ),
        $replaced, 'replace_manpage_separator()' );
}

# maybe_command()
SKIP: {
    skip( '$ENV{COMSPEC} not set', 2 )
        unless $ENV{COMSPEC} =~ m!((?:[a-z]:)?[^|<>]+)!i;
    my $comspec = $1;
    is( $MM->maybe_command( $comspec ), 
        $comspec, 'COMSPEC is a maybe_command()' );
    ( my $comspec2 = $comspec ) =~ s|\..{3}$||;
    like( $MM->maybe_command( $comspec2 ), 
          qr/\Q$comspec/i, 
          'maybe_command() without extension' );
}

my $had_pathext = exists $ENV{PATHEXT};
{
    local $ENV{PATHEXT} = '.exe';
    ok( ! $MM->maybe_command( 'not_a_command.com' ), 
        'not a maybe_command()' );
}
# Bug in Perl.  local $ENV{FOO} won't delete the key afterward.
delete $ENV{PATHEXT} unless $had_pathext;

# file_name_is_absolute() [Does not support UNC-paths]
{
    ok( $MM->file_name_is_absolute( 'C:/' ), 
        'file_name_is_absolute()' );
    ok( ! $MM->file_name_is_absolute( 'some/path/' ),
        'not file_name_is_absolute()' );

}

# find_perl() 
# Should be able to find running perl... $^X is OK on Win32
{
    my $my_perl = $1 if $^X  =~ /(.*)/; # are we in -T or -t?
    my( $perl, $path ) = fileparse( $my_perl );
    like( $MM->find_perl( $], [ $perl ], [ $path ], 0 ),
          qr/^\Q$my_perl\E$/i, 'find_perl() finds this perl' );
}

# catdir() (calls MM_Win32->canonpath)
{
    my @path_eg = qw( c: trick dir/now_OK );

    is( $MM->catdir( @path_eg ), 
         'C:\\trick\\dir\\now_OK', 'catdir()' );
    is( $MM->catdir( @path_eg ), 
        File::Spec->catdir( @path_eg ), 
        'catdir() eq File::Spec->catdir()' );

# catfile() (calls MM_Win32->catdir)
    push @path_eg, 'file.ext';

    is( $MM->catfile( @path_eg ),
        'C:\\trick\\dir\\now_OK\\file.ext', 'catfile()' );

    is( $MM->catfile( @path_eg ), 
        File::Spec->catfile( @path_eg ), 
        'catfile() eq File::Spec->catfile()' );
}

# init_others(): check if all keys are created and set?
# qw( TOUCH CHMOD CP RM_F RM_RF MV NOOP TEST_F LD AR LDLOADLIBS DEV_NUL )
{
    my $mm_w32 = bless( { BASEEXT => 'Foo' }, 'MM' );
    $mm_w32->init_others();
    my @keys = qw( TOUCH CHMOD CP RM_F RM_RF MV NOOP 
                   TEST_F LD AR LDLOADLIBS DEV_NULL );
    for my $key ( @keys ) {
        ok( $mm_w32->{ $key }, "init_others: $key" );
    }
}

# constants()
# XXX this test is probably useless now that we can call individual
# init_* methods and check the keys in $mm_w32 directly
{
    my $mm_w32 = bless {
        NAME         => 'TestMM_Win32', 
        VERSION      => '1.00',
        PM           => { 'MM_Win32.pm' => 1 },
    }, 'MM';

    # XXX Hack until we have a proper init method.
    # Flesh out some necessary keys in the MM object.
    @{$mm_w32}{qw(XS MAN1PODS MAN3PODS)} = ({}) x 3;
    @{$mm_w32}{qw(C O_FILES H)}          = ([]) x 3;
    @{$mm_w32}{qw(PARENT_NAME)}          = ('') x 3;
    $mm_w32->{FULLEXT} = 'TestMM_Win32';
    $mm_w32->{BASEEXT} = 'TestMM_Win32';

    $mm_w32->init_VERSION;
    $mm_w32->init_linker;
    $mm_w32->init_INST;
    $mm_w32->init_xs;

    my $s_PM = join( " \\\n\t", sort keys %{$mm_w32->{PM}} );
    my $k_PM = join( " \\\n\t", %{$mm_w32->{PM}} );

    my $constants = $mm_w32->constants;

    foreach my $regex (
         qr|^NAME       \s* = \s* TestMM_Win32 \s* $|xms,
         qr|^VERSION    \s* = \s* 1\.00 \s* $|xms,
         qr|^MAKEMAKER  \s* = \s* \Q$INC{'ExtUtils/MakeMaker.pm'}\E \s* $|xms,
         qr|^MM_VERSION \s* = \s* \Q$ExtUtils::MakeMaker::VERSION\E \s* $|xms,
         qr|^TO_INST_PM \s* = \s* \Q$s_PM\E \s* $|xms,
         qr|^PM_TO_BLIB \s* = \s* \Q$k_PM\E \s* $|xms,
        )
    {
        like( $constants, $regex, 'constants() check' );
    }
}

# path()
{
    ok( eq_array( [ $MM->path() ], [ File::Spec->path ] ),
        'path() [preset]' );
}

# static_lib() should look into that
# dynamic_bs() should look into that
# dynamic_lib() should look into that

# init_linker
{
    my $libperl = File::Spec->catfile('$(PERL_INC)', 
                                      $Config{libperl} || 'libperl.a');
    my $export  = '$(BASEEXT).def';
    my $after   = '';
    $MM->init_linker;

    is( $MM->{PERL_ARCHIVE},        $libperl,   'PERL_ARCHIVE' );
    is( $MM->{PERL_ARCHIVE_AFTER},  $after,     'PERL_ARCHIVE_AFTER' );
    is( $MM->{EXPORT_LIST},         $export,    'EXPORT_LIST' );
}

# canonpath()
{
    my $path = 'c:\\Program Files/SomeApp\\Progje.exe';
    is( $MM->canonpath( $path ), File::Spec->canonpath( $path ),
	    'canonpath() eq File::Spec->canonpath' );
}

# perl_script()
my $script_ext  = '';
my $script_name = 'mm_w32tmp';
SKIP: {
    local *SCRIPT;
    skip( "Can't create temp file: $!", 4 )
        unless open SCRIPT, "> $script_name";
    print SCRIPT <<'EOSCRIPT';
#! perl
__END__
EOSCRIPT
    skip( "Can't write to temp file: $!", 4 )
        unless close SCRIPT;
    # now start tests:
    is( $MM->perl_script( $script_name ), 
        "${script_name}$script_ext", "perl_script ($script_ext)" );

    skip( "Can't rename temp file: $!", 3 )
        unless rename $script_name, "${script_name}.pl";
    $script_ext = '.pl';
    is( $MM->perl_script( $script_name ), 
        "${script_name}$script_ext", "perl_script ($script_ext)" );

    skip( "Can't rename temp file: $!", 2 )
        unless rename "${script_name}$script_ext", "${script_name}.bat";
    $script_ext = '.bat';
    is( $MM->perl_script( $script_name ), 
        "${script_name}$script_ext", "perl_script ($script_ext)" );

    skip( "Can't rename temp file: $!", 1 )
        unless rename "${script_name}$script_ext", "${script_name}.noscript";
    $script_ext = '.noscript';

    isnt( $MM->perl_script( $script_name ),
          "${script_name}$script_ext", 
          "not a perl_script anymore ($script_ext)" );
    is( $MM->perl_script( $script_name ), undef,
        "perl_script ($script_ext) returns empty" );
}
unlink "${script_name}$script_ext" if -f "${script_name}$script_ext";


# xs_o() should look into that
# top_targets() should look into that

# dist_ci() should look into that
# dist_core() should look into that

# pasthru()
{
    my $pastru = "PASTHRU = " . ($Config{make} =~ /^nmake/i ? "-nologo" : "");
    is( $MM->pasthru(), $pastru, 'pasthru()' );
}

package FakeOut;

sub TIEHANDLE {
	bless(\(my $scalar), $_[0]);
}

sub PRINT {
	my $self = shift;
	$$self .= shift;
}

__END__

=head1 NAME

MM_Win32.t - Tests for ExtUtils::MM_Win32

=head1 TODO

 - Methods to still be checked:
 # static_lib() should look into that
 # dynamic_bs() should look into that
 # dynamic_lib() should look into that
 # xs_o() should look into that
 # top_targets() should look into that
 # dist_ci() should look into that
 # dist_core() should look into that

=head1 AUTHOR

20011228 Abe Timmerman <abe at ztreet.demon.nl>

=cut

--- NEW FILE: Command.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib/');
    }
    else {
        unshift @INC, 't/lib/';
    }
}
chdir 't';

BEGIN {
    $Testfile = 'testfile.foo';
}

BEGIN {
    1 while unlink $Testfile, 'newfile';
    # forcibly remove ecmddir/temp2, but don't import mkpath
    use File::Path ();
    File::Path::rmtree( 'ecmddir' );
}

BEGIN {
    use Test::More tests => 38;
    use File::Spec;
}

BEGIN {
    # bad neighbor, but test_f() uses exit()
        *CORE::GLOBAL::exit = '';   # quiet 'only once' warning.
    *CORE::GLOBAL::exit = sub { return @_ };
    use_ok( 'ExtUtils::Command' );
}

{
    # concatenate this file with itself
    # be extra careful the regex doesn't match itself
    use TieOut;
    my $out = tie *STDOUT, 'TieOut';
    my $self = $0;
    unless (-f $self) {
        my ($vol, $dirs, $file) = File::Spec->splitpath($self);
        my @dirs = File::Spec->splitdir($dirs);
        unshift(@dirs, File::Spec->updir);
        $dirs = File::Spec->catdir(@dirs);
        $self = File::Spec->catpath($vol, $dirs, $file);
    }
    @ARGV = ($self, $self);

    cat();
    is( scalar( $$out =~ s/use_ok\( 'ExtUtils::Command'//g), 2, 
        'concatenation worked' );

    # the truth value here is reversed -- Perl true is C false
    @ARGV = ( $Testfile );
    ok( test_f(), 'testing non-existent file' );

    @ARGV = ( $Testfile );
    cmp_ok( ! test_f(), '==', defined (-f $Testfile), 'testing non-existent file' );

    # these are destructive, have to keep setting @ARGV
    @ARGV = ( $Testfile );
    touch();

    @ARGV = ( $Testfile );
    ok( test_f(), 'now creating that file' );
    is_deeply( \@ARGV, [$Testfile], 'test_f preserves @ARGV' );

    @ARGV = ( $Testfile );
    ok( -e $ARGV[0], 'created!' );

    my ($now) = time;
    utime ($now, $now, $ARGV[0]);
    sleep 2;

    # Just checking modify time stamp, access time stamp is set
    # to the beginning of the day in Win95.
    # There's a small chance of a 1 second flutter here.
    my $stamp = (stat($ARGV[0]))[9];
    cmp_ok( abs($now - $stamp), '<=', 1, 'checking modify time stamp' ) ||
      diag "mtime == $stamp, should be $now";

    @ARGV = qw(newfile);
    touch();

    my $new_stamp = (stat('newfile'))[9];
    cmp_ok( abs($new_stamp - $stamp), '>=', 2,  'newer file created' );

    @ARGV = ('newfile', $Testfile);
    eqtime();

    $stamp = (stat($Testfile))[9];
    cmp_ok( abs($new_stamp - $stamp), '<=', 1, 'eqtime' );

    # eqtime use to clear the contents of the file being equalized!
    open(FILE, ">>$Testfile") || die $!;
    print FILE "Foo";
    close FILE;

    @ARGV = ('newfile', $Testfile);
    eqtime();
    ok( -s $Testfile, "eqtime doesn't clear the file being equalized" );

    SKIP: {
        if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' ||
            $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin'  ||
            $^O eq 'MacOS'
           ) {
            skip( "different file permission semantics on $^O", 3);
        }

        # change a file to execute-only
        @ARGV = ( '0100', $Testfile );
        ExtUtils::Command::chmod();

        is( ((stat($Testfile))[2] & 07777) & 0700,
            0100, 'change a file to execute-only' );

        # change a file to read-only
        @ARGV = ( '0400', $Testfile );
        ExtUtils::Command::chmod();

        is( ((stat($Testfile))[2] & 07777) & 0700,
            ($^O eq 'vos' ? 0500 : 0400), 'change a file to read-only' );

        # change a file to write-only
        @ARGV = ( '0200', $Testfile );
        ExtUtils::Command::chmod();

        is( ((stat($Testfile))[2] & 07777) & 0700,
            ($^O eq 'vos' ? 0700 : 0200), 'change a file to write-only' );
    }

    # change a file to read-write
    @ARGV = ( '0600', $Testfile );
    my @orig_argv = @ARGV;
    ExtUtils::Command::chmod();
    is_deeply( \@ARGV, \@orig_argv, 'chmod preserves @ARGV' );

    is( ((stat($Testfile))[2] & 07777) & 0700,
        ($^O eq 'vos' ? 0700 : 0600), 'change a file to read-write' );


    SKIP: {
        if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' ||
            $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin'  ||
            $^O eq 'MacOS'
           ) {
            skip( "different file permission semantics on $^O", 4);
        }

        @ARGV = ('testdir');
        mkpath;
        ok( -e 'testdir' );

        # change a dir to execute-only
        @ARGV = ( '0100', 'testdir' );
        ExtUtils::Command::chmod();

        is( ((stat('testdir'))[2] & 07777) & 0700,
            0100, 'change a dir to execute-only' );

        # change a dir to read-only
        @ARGV = ( '0400', 'testdir' );
        ExtUtils::Command::chmod();

        is( ((stat('testdir'))[2] & 07777) & 0700,
            ($^O eq 'vos' ? 0500 : 0400), 'change a dir to read-only' );

        # change a dir to write-only
        @ARGV = ( '0200', 'testdir' );
        ExtUtils::Command::chmod();

        is( ((stat('testdir'))[2] & 07777) & 0700,
            ($^O eq 'vos' ? 0700 : 0200), 'change a dir to write-only' );

        @ARGV = ('testdir');
        rm_rf;
    }


    # mkpath
    @ARGV = ( File::Spec->join( 'ecmddir', 'temp2' ) );
    ok( ! -e $ARGV[0], 'temp directory not there yet' );

    mkpath();
    ok( -e $ARGV[0], 'temp directory created' );

    # copy a file to a nested subdirectory
    unshift @ARGV, $Testfile;
    @orig_argv = @ARGV;
    cp();
    is_deeply( \@ARGV, \@orig_argv, 'cp preserves @ARGV' );

    ok( -e File::Spec->join( 'ecmddir', 'temp2', $Testfile ), 'copied okay' );

    # cp should croak if destination isn't directory (not a great warning)
    @ARGV = ( $Testfile ) x 3;
    eval { cp() };

    like( $@, qr/Too many arguments/, 'cp croaks on error' );

    # move a file to a subdirectory
    @ARGV = ( $Testfile, 'ecmddir' );
    @orig_argv = @ARGV;
    ok( mv() );
    is_deeply( \@ARGV, \@orig_argv, 'mv preserves @ARGV' );

    ok( ! -e $Testfile, 'moved file away' );
    ok( -e File::Spec->join( 'ecmddir', $Testfile ), 'file in new location' );

    # mv should also croak with the same wacky warning
    @ARGV = ( $Testfile ) x 3;

    eval { mv() };
    like( $@, qr/Too many arguments/, 'mv croaks on error' );

    # Test expand_wildcards()
    {
        my $file = $Testfile;
        @ARGV = ();
        chdir 'ecmddir';

        # % means 'match one character' on VMS.  Everything else is ?
        my $match_char = $^O eq 'VMS' ? '%' : '?';
        ($ARGV[0] = $file) =~ s/.\z/$match_char/;

        # this should find the file
        ExtUtils::Command::expand_wildcards();

        is_deeply( \@ARGV, [$file], 'expanded wildcard ? successfully' );

        # try it with the asterisk now
        ($ARGV[0] = $file) =~ s/.{3}\z/\*/;
        ExtUtils::Command::expand_wildcards();

        is_deeply( \@ARGV, [$file], 'expanded wildcard * successfully' );

        chdir File::Spec->updir;
    }

    # remove some files
    my @files = @ARGV = ( File::Spec->catfile( 'ecmddir', $Testfile ),
    File::Spec->catfile( 'ecmddir', 'temp2', $Testfile ) );
    rm_f();

    ok( ! -e $_, "removed $_ successfully" ) for (@ARGV);

    # rm_f dir
    @ARGV = my $dir = File::Spec->catfile( 'ecmddir' );
    rm_rf();
    ok( ! -e $dir, "removed $dir successfully" );
}

{
    { local @ARGV = 'd2utest'; mkpath; }
    open(FILE, '>d2utest/foo');
    print FILE "stuff\015\012and thing\015\012";
    close FILE;

    open(FILE, '>d2utest/bar');
    binmode(FILE);
    my $bin = "\c@\c@\c@\c@\c@\c@\cA\c@\c@\c@\015\012".
              "\@\c@\cA\c@\c@\c at 8__LIN\015\012";
    print FILE $bin;
    close FILE;

    local @ARGV = 'd2utest';
    ExtUtils::Command::dos2unix();

    open(FILE, 'd2utest/foo');
    is( join('', <FILE>), "stuff\012and thing\012", 'dos2unix' );
    close FILE;

    open(FILE, 'd2utest/bar');
    binmode(FILE);
    ok( -B 'd2utest/bar' );
    is( join('', <FILE>), $bin, 'dos2unix preserves binaries');
    close FILE;
}

END {
    1 while unlink $Testfile, 'newfile';
    File::Path::rmtree( 'ecmddir' );
    File::Path::rmtree( 'd2utest' );
}

--- NEW FILE: testlib.t ---
#!/usr/bin/perl -Tw

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        # ./lib is there so t/lib can be seen even after we chdir.
        unshift @INC, 't/lib', './lib';
    }
}
chdir 't';

use Test::More tests => 5;

BEGIN { 
    # non-core tests will have blib in their path.  We remove it
    # and just use the one in lib/.
    unless( $ENV{PERL_CORE} ) {
        @INC = grep !/blib/, @INC;
        unshift @INC, '../lib';
    }
}

my @blib_paths = grep /blib/, @INC;
is( @blib_paths, 0, 'No blib dirs yet in @INC' );

use_ok( 'ExtUtils::testlib' );

@blib_paths = grep { /blib/ } @INC;
is( @blib_paths, 2, 'ExtUtils::testlib added two @INC dirs!' );
ok( !(grep !File::Spec->file_name_is_absolute($_), @blib_paths),
                    '  and theyre absolute');

eval { eval "# @INC"; };
is( $@, '',     '@INC is not tainted' );

--- NEW FILE: config.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = ('../lib', 'lib/');
    }
    else {
        unshift @INC, 't/lib/';
    }
}

use Test::More tests => 3;
use Config ();

BEGIN { use_ok 'ExtUtils::MakeMaker::Config'; }

is $Config{path_sep}, $Config::Config{path_sep};

eval {
    $Config{wibble} = 42;
};
is $Config{wibble}, 42;

--- NEW FILE: Embed.t ---
#!/usr/bin/perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
}
chdir 't';

use Config;
use ExtUtils::Embed;
use File::Spec;

open(my $fh,">embed_test.c") || die "Cannot open embed_test.c:$!";
print $fh <DATA>;
close($fh);

$| = 1;
print "1..9\n";
my $cc = $Config{'cc'};
my $cl  = ($^O eq 'MSWin32' && $cc eq 'cl');
my $borl  = ($^O eq 'MSWin32' && $cc eq 'bcc32');
my $skip_exe = $^O eq 'os2' && $Config{ldflags} =~ /(?<!\S)-Zexe\b/;
my $exe = 'embed_test';
$exe .= $Config{'exe_ext'} unless $skip_exe;	# Linker will auto-append it
my $obj = 'embed_test' . $Config{'obj_ext'};
my $inc = File::Spec->updir;
my $lib = File::Spec->updir;
my $libperl_copied;
my $testlib;
my @cmd;
my (@cmd2) if $^O eq 'VMS';

if ($^O eq 'VMS') {
    push(@cmd,$cc,"/Obj=$obj");
    my (@incs) = ($inc);
    my $crazy = ccopts();
    if ($crazy =~ s#/inc[^=/]*=([\w\$\_\-\.\[\]\:]+)##i) {
        push(@incs,$1);
    }
    if ($crazy =~ s/-I([a-zA-Z0-9\$\_\-\.\[\]\:]*)//) {
        push(@incs,$1);
    }
    $crazy =~ s#/Obj[^=/]*=[\w\$\_\-\.\[\]\:]+##i;
    push(@cmd,"/Include=(".join(',', at incs).")");
    push(@cmd,$crazy);
    push(@cmd,"embed_test.c");

    push(@cmd2,$Config{'ld'}, $Config{'ldflags'}, "/exe=$exe"); 
    push(@cmd2,"$obj,[-]perlshr.opt/opt,[-]perlshr_attr.opt/opt");

} else {
   if ($cl) {
    push(@cmd,$cc,"-Fe$exe");
   }
   elsif ($borl) {
    push(@cmd,$cc,"-o$exe");
   }
   else {
    push(@cmd,$cc,'-o' => $exe);
   }
   push(@cmd,"-I$inc",ccopts(),'embed_test.c');
   if ($^O eq 'MSWin32') {
    $inc = File::Spec->catdir($inc,'win32');
    push(@cmd,"-I$inc");
    $inc = File::Spec->catdir($inc,'include');
    push(@cmd,"-I$inc");
    if ($cc eq 'cl') {
	push(@cmd,'-link',"-libpath:$lib",$Config{'libperl'},$Config{'libs'});
    }
    else {
	push(@cmd,"-L$lib",File::Spec->catfile($lib,$Config{'libperl'}),$Config{'libc'});
    }
   }
   else { # Not MSWin32.
    push(@cmd,"-L$lib",'-lperl');
    local $SIG{__WARN__} = sub {
	warn $_[0] unless $_[0] =~ /No library found for .*perl/
    };
    push(@cmd, '-Zlinker', '/PM:VIO')	# Otherwise puts a warning to STDOUT!
	if $^O eq 'os2' and $Config{ldflags} =~ /(?<!\S)-Zomf\b/;
    push(@cmd,ldopts());
   }
   if ($borl) {
     @cmd = ($cmd[0],(grep{/^-[LI]/}@cmd[1..$#cmd]),(grep{!/^-[LI]/}@cmd[1..$#cmd]));
   }

   if ($^O eq 'aix') { # AIX needs an explicit symbol export list.
    my ($perl_exp) = grep { -f } qw(perl.exp ../perl.exp);
    die "where is perl.exp?\n" unless defined $perl_exp;
    for (@cmd) {
        s!-bE:(\S+)!-bE:$perl_exp!;
    }
   }
   elsif ($^O eq 'cygwin') { # Cygwin needs the shared libperl copied
     my $v_e_r_s = $Config{version};
     $v_e_r_s =~ tr/./_/;
     system("cp ../cygperl$v_e_r_s.dll ./");    # for test 1
   }
   elsif ($Config{'libperl'} !~ /\Alibperl\./) {
     # Everyone needs libperl copied if it's not found by '-lperl'.
     $testlib = $Config{'libperl'};
     my $srclib = $testlib;
     $testlib =~ s/.+(?=\.[^.]*)/libperl/;
     $testlib = File::Spec::->catfile($lib, $testlib);
     $srclib = File::Spec::->catfile($lib, $srclib);
     if (-f $srclib) {
       unlink $testlib if -f $testlib;
       my $ln_or_cp = $Config{'ln'} || $Config{'cp'};
       my $lncmd = "$ln_or_cp $srclib $testlib";
       #print "# $lncmd\n";
       $libperl_copied = 1	unless system($lncmd);
     }
   }
}
my $status;
# On OS/2 the linker will always emit an empty line to STDOUT; filter these
my $cmd = join ' ', @cmd;
chomp($cmd); # where is the newline coming from? ldopts()?
print "# $cmd\n";
my @out = `$cmd`;
$status = $?;
print "# $_\n" foreach @out;

if ($^O eq 'VMS' && !$status) {
  print "# @cmd2\n";
  $status = system(join(' ', at cmd2)); 
}
print (($status? 'not ': '')."ok 1\n");

my $embed_test = File::Spec->catfile(File::Spec->curdir, $exe);
$embed_test = "run/nodebug $exe" if $^O eq 'VMS';
print "# embed_test = $embed_test\n";
$status = system($embed_test);
print (($status? 'not ':'')."ok 9 # system returned $status\n");
unlink($exe,"embed_test.c",$obj);
unlink("$exe$Config{exe_ext}") if $skip_exe;
unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS';
unlink(glob("./*.dll")) if $^O eq 'cygwin';
unlink($testlib)	       if $libperl_copied;

# gcc -g -I.. -L../ -o perl_test perl_test.c -lperl `../perl -I../lib -MExtUtils::Embed -I../ -e ccopts -e ldopts`

__END__

/* perl_test.c */

#include <EXTERN.h>
#include <perl.h>

#define my_puts(a) if(puts(a) < 0) exit(666)

static char *cmds[] = { "perl","-e", "$|=1; print qq[ok 5\\n]", NULL };

#ifdef PERL_GLOBAL_STRUCT_PRIVATE
static struct perl_vars *my_plvarsp;
struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
#endif

int main(int argc, char **argv, char **env)
{
    PerlInterpreter *my_perl;
#ifdef PERL_GLOBAL_STRUCT
    dVAR;
    struct perl_vars *plvarsp = init_global_struct();
#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
    my_vars = my_plvarsp = plvarsp;
#  endif
#endif /* PERL_GLOBAL_STRUCT */

    (void)argc; /* PERL_SYS_INIT3 may #define away their use */
    (void)argv;
    PERL_SYS_INIT3(&argc,&argv,&env);

    my_perl = perl_alloc();

    my_puts("ok 2");

    perl_construct(my_perl);

    my_puts("ok 3");

    perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, cmds, env);

    my_puts("ok 4");

    fflush(stdout);

    perl_run(my_perl);

    my_puts("ok 6");

    perl_destruct(my_perl);

    my_puts("ok 7");

    perl_free(my_perl);

#ifdef PERL_GLOBAL_STRUCT
    free_global_struct(plvarsp);
#endif /* PERL_GLOBAL_STRUCT */

    my_puts("ok 8");

    PERL_SYS_TERM();

    return 0;
}

--- NEW FILE: MM_VMS.t ---
#!/usr/bin/perl -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    else {
        unshift @INC, 't/lib';
    }
}
chdir 't';

BEGIN {
    @Methods = (qw(wraplist
                   rootdir
                   ext
                   guess_name
                   find_perl
                   path
                   maybe_command
                   perl_script
                   file_name_is_absolute
                   replace_manpage_separator
                   init_others
                   constants
                   cflags
                   const_cccmd
                   pm_to_blib
                   tool_autosplit
                   tool_xsubpp
                   tools_other
                   dist
                   c_o
                   xs_c
                   xs_o
                   top_targets
                   dlsyms
                   dynamic_lib
                   dynamic_bs
                   static_lib
                   manifypods
                   processPL
                   installbin
                   subdir_x
                   clean
                   realclean
                   dist_basics
                   dist_core
                   distdir
                   dist_test
                   install
                   perldepend
                   makefile
                   test
                   test_via_harness
                   test_via_script
                   makeaperl
                   nicetext
                  ));
}

BEGIN {
    use Test::More;
    if ($^O eq 'VMS') {
        plan( tests => @Methods + 1 );
    }
    else {
        plan( skip_all => "This is not VMS" );
    }
}

use_ok( 'ExtUtils::MM_VMS' );

foreach my $meth (@Methods) {
    can_ok( 'ExtUtils::MM_VMS', $meth);
}




More information about the dslinux-commit mailing list