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 <schwern\@pobox.com></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