diff options
| author |   millert <millert@openbsd.org> | 2003-12-03 02:43:04 +0000 |
|---|---|---|
| committer | millert <millert@openbsd.org> | 2003-12-03 02:43:04 +0000 |
| commit | 8500990981f885cbe5e6a4958549cacc238b5ae6 (patch) | |
| tree | 459d709ffae0599d6d549087d270bfb6d2fcf5e6 /gnu/usr.bin/perl/lib/ExtUtils/t | |
| parent | sync (diff) | |
| download | wireguard-openbsd-8500990981f885cbe5e6a4958549cacc238b5ae6.tar.xz wireguard-openbsd-8500990981f885cbe5e6a4958549cacc238b5ae6.zip | |
perl 5.8.2 from CPAN
Diffstat (limited to 'gnu/usr.bin/perl/lib/ExtUtils/t')
31 files changed, 1928 insertions, 762 deletions
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/00compile.t b/gnu/usr.bin/perl/lib/ExtUtils/t/00compile.t new file mode 100644 index 00000000000..5eb015b13dd --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/00compile.t @@ -0,0 +1,42 @@ +#!/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} } <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); + } +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t b/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t index 2d5b1ee5c1b..0b9e58d056a 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/00setup_dummy.t @@ -16,24 +16,50 @@ use File::Basename; use File::Path; use File::Spec; +if( $^O eq 'VMS' ) { + # On older systems we might exceed the 8-level directory depth limit + # imposed by RMS. We get around this with a rooted logical, but we + # can't create logical names with attributes in Perl, so we do it + # in a DCL subprocess and put it in the job table so the parent sees it. + open( BFDTMP, '>bfdtesttmp.com' ) || die "Error creating command file; $!"; + print BFDTMP <<'COMMAND'; +$ BFD_TEST_ROOT = F$PARSE("SYS$DISK:[-]",,,,"NO_CONCEAL")-".][000000"-"]["-"].;"+".]" +$ DEFINE/JOB/NOLOG/TRANSLATION=CONCEALED BFD_TEST_ROOT 'BFD_TEST_ROOT' +COMMAND + close BFDTMP; + + system '@bfdtesttmp.com'; + 1 while unlink 'bfdtesttmp.com'; +} + + my %Files = ( 'Big-Dummy/lib/Big/Dummy.pm' => <<'END', package Big::Dummy; $VERSION = 0.01; +=head1 NAME + +Big::Dummy - Try "our" hot dog's + +=cut + 1; END 'Big-Dummy/Makefile.PL' => <<'END', use ExtUtils::MakeMaker; -printf "Current package is: %s\n", __PACKAGE__; +# This will interfere with the PREREQ_PRINT tests. +printf "Current package is: %s\n", __PACKAGE__ unless "@ARGV" =~ /PREREQ/; WriteMakefile( NAME => 'Big::Dummy', VERSION_FROM => 'lib/Big/Dummy.pm', - PREREQ_PM => {}, + PREREQ_PM => { strict => 0 }, + ABSTRACT_FROM => 'lib/Big/Dummy.pm', + AUTHOR => 'Michael G Schwern <schwern@pobox.com>', ); END diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Command.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Command.t index ff9eec1da42..bf7d177889f 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/Command.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Command.t @@ -12,98 +12,96 @@ BEGIN { chdir 't'; BEGIN { - 1 while unlink 'ecmdfile'; - # forcibly remove ecmddir/temp2, but don't import mkpath - use File::Path (); - File::Path::rmtree( 'ecmddir' ); + $Testfile = 'testfile.foo'; } BEGIN { - use Test::More tests => 24; - use File::Spec; + 1 while unlink $Testfile, 'newfile'; + # forcibly remove ecmddir/temp2, but don't import mkpath + use File::Path (); + File::Path::rmtree( 'ecmddir' ); } -{ - # bad neighbor, but test_f() uses exit() - *CORE::GLOBAL::exit = ''; # quiet 'only once' warning. - *CORE::GLOBAL::exit = sub { return @_ }; +BEGIN { + use Test::More tests => 26; + use File::Spec; +} - use_ok( 'ExtUtils::Command' ); +BEGIN { + # bad neighbor, but test_f() uses exit() + *CORE::GLOBAL::exit = ''; # quiet 'only once' warning. + *CORE::GLOBAL::exit = sub { return @_ }; + use_ok( 'ExtUtils::Command' ); +} - # get a file in the current directory, replace last char with wildcard - my $file; - { - local *DIR; - opendir(DIR, File::Spec->curdir()); - while ($file = readdir(DIR)) { - $file =~ s/\.\z// if $^O eq 'VMS'; - last if $file =~ /^\w/; - } - } +{ + # 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' ); - # % means 'match one character' on VMS. Everything else is ? - my $match_char = $^O eq 'VMS' ? '%' : '?'; - ($ARGV[0] = $file) =~ s/.\z/$match_char/; + # the truth value here is reversed -- Perl true is C false + @ARGV = ( $Testfile ); + ok( test_f(), 'testing non-existent file' ); - # this should find the file - ExtUtils::Command::expand_wildcards(); + @ARGV = ( $Testfile ); + cmp_ok( ! test_f(), '==', (-f $Testfile), 'testing non-existent file' ); - is( scalar @ARGV, 1, 'found one file' ); - like( $ARGV[0], qr/$file/, 'expanded wildcard ? successfully' ); + # these are destructive, have to keep setting @ARGV + @ARGV = ( $Testfile ); + touch(); - # try it with the asterisk now - ($ARGV[0] = $file) =~ s/.{3}\z/\*/; - ExtUtils::Command::expand_wildcards(); + @ARGV = ( $Testfile ); + ok( test_f(), 'now creating that file' ); - ok( (grep { qr/$file/ } @ARGV), 'expanded wildcard * successfully' ); + @ARGV = ( $Testfile ); + ok( -e $ARGV[0], 'created!' ); - # 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 = ( 'ecmdfile' ); - ok( test_f(), 'testing non-existent file' ); - - @ARGV = ( 'ecmdfile' ); - cmp_ok( ! test_f(), '==', (-f 'ecmdfile'), 'testing non-existent file' ); - - # these are destructive, have to keep setting @ARGV - @ARGV = ( 'ecmdfile' ); - touch(); - - @ARGV = ( 'ecmdfile' ); - ok( test_f(), 'now creating that file' ); - - @ARGV = ( 'ecmdfile' ); - ok( -e $ARGV[0], 'created!' ); - - my ($now) = time; - utime ($now, $now, $ARGV[0]); + 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. + # 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' ) || + 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' || @@ -113,80 +111,104 @@ BEGIN { } # change a file to execute-only - @ARGV = ( 0100, 'ecmdfile' ); + @ARGV = ( '0100', $Testfile ); ExtUtils::Command::chmod(); - is( ((stat('ecmdfile'))[2] & 07777) & 0700, + is( ((stat($Testfile))[2] & 07777) & 0700, 0100, 'change a file to execute-only' ); # change a file to read-only - @ARGV = ( 0400, 'ecmdfile' ); + @ARGV = ( '0400', $Testfile ); ExtUtils::Command::chmod(); - is( ((stat('ecmdfile'))[2] & 07777) & 0700, + 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, 'ecmdfile' ); + @ARGV = ( '0200', $Testfile ); ExtUtils::Command::chmod(); - is( ((stat('ecmdfile'))[2] & 07777) & 0700, + 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, 'ecmdfile' ); - ExtUtils::Command::chmod(); + @ARGV = ( '0600', $Testfile ); + ExtUtils::Command::chmod(); - is( ((stat('ecmdfile'))[2] & 07777) & 0700, + is( ((stat($Testfile))[2] & 07777) & 0700, ($^O eq 'vos' ? 0700 : 0600), 'change a file to read-write' ); - # mkpath - @ARGV = ( File::Spec->join( 'ecmddir', 'temp2' ) ); - ok( ! -e $ARGV[0], 'temp directory not there yet' ); + # 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; + cp(); + + ok( -e File::Spec->join( 'ecmddir', 'temp2', $Testfile ), 'copied okay' ); - mkpath(); - ok( -e $ARGV[0], 'temp directory created' ); + # cp should croak if destination isn't directory (not a great warning) + @ARGV = ( $Testfile ) x 3; + eval { cp() }; - # copy a file to a nested subdirectory - unshift @ARGV, 'ecmdfile'; - cp(); + like( $@, qr/Too many arguments/, 'cp croaks on error' ); - ok( -e File::Spec->join( 'ecmddir', 'temp2', 'ecmdfile' ), 'copied okay' ); + # move a file to a subdirectory + @ARGV = ( $Testfile, 'ecmddir' ); + mv(); - # cp should croak if destination isn't directory (not a great warning) - @ARGV = ( 'ecmdfile' ) x 3; - eval { cp() }; + ok( ! -e $Testfile, 'moved file away' ); + ok( -e File::Spec->join( 'ecmddir', $Testfile ), 'file in new location' ); - like( $@, qr/Too many arguments/, 'cp croaks on error' ); + # mv should also croak with the same wacky warning + @ARGV = ( $Testfile ) x 3; - # move a file to a subdirectory - @ARGV = ( 'ecmdfile', 'ecmddir' ); - mv(); + eval { mv() }; + like( $@, qr/Too many arguments/, 'mv croaks on error' ); - ok( ! -e 'ecmdfile', 'moved file away' ); - ok( -e File::Spec->join( 'ecmddir', 'ecmdfile' ), 'file in new location' ); + # Test expand_wildcards() + { + my $file = $Testfile; + @ARGV = (); + chdir 'ecmddir'; - # mv should also croak with the same wacky warning - @ARGV = ( 'ecmdfile' ) x 3; + # % means 'match one character' on VMS. Everything else is ? + my $match_char = $^O eq 'VMS' ? '%' : '?'; + ($ARGV[0] = $file) =~ s/.\z/$match_char/; - eval { mv() }; - like( $@, qr/Too many arguments/, 'mv croaks on error' ); + # 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', 'ecmdfile' ), - File::Spec->catfile( 'ecmddir', 'temp2', 'ecmdfile' ) ); - rm_f(); + # 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); + ok( ! -e $_, "removed $_ successfully" ) for (@ARGV); - # rm_f dir - @ARGV = my $dir = File::Spec->catfile( 'ecmddir' ); - rm_rf(); - ok( ! -e $dir, "removed $dir successfully" ); + # rm_f dir + @ARGV = my $dir = File::Spec->catfile( 'ecmddir' ); + rm_rf(); + ok( ! -e $dir, "removed $dir successfully" ); } END { - 1 while unlink 'ecmdfile'; - File::Path::rmtree( 'ecmddir' ); + 1 while unlink $Testfile, 'newfile'; + File::Path::rmtree( 'ecmddir' ); } diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Constant.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Constant.t index 25d705585e2..af637673fb7 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/Constant.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Constant.t @@ -1,191 +1,349 @@ #!/usr/bin/perl -w -print "1..51\n"; - 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 Config; -use File::Spec::Functions qw(catfile rel2abs); +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; -$perl = rel2abs( $^X ) unless $] < 5.006; # Hack. Until 5.00503 has rel2abs +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 $runperl = "$perl \"-I../../lib\""; -$| = 1; +my $make = $Config{make}; +$make = $ENV{MAKE} if exists $ENV{MAKE}; +if ($^O eq 'MSWin32' && $make eq 'nmake') { $make .= " -nologo"; } + +# Renamed by make clean +my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile'); +my $makefile_ext = ($^O eq 'VMS' ? '.mms' : ''); +my $makefile_rename = $makefile . ($^O eq 'VMS' ? '.mms' : '.old'); +my $output = "output"; +my $package = "ExtTest"; my $dir = "ext-$$"; -my @files; +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"; -my $output = "output"; - -# For debugging set this to 1. -my $keep_files = 0; - 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; + } } -my $package = "ExtTest"; +chdir $dir or die $!; +push @INC, '../../lib', '../../../lib'; -# 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 -); +sub check_for_bonus_files { + my $dir = shift; + my %expect = map {($^O eq 'VMS' ? lc($_) : $_), 1} @_; -my $parent_rfc1149 = - 'A Standard for the Transmission of IP Datagrams on Avian Carriers'; -# Check that 8 bit and unicode names don't cause problems. -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 $inf = chr 0x221E; -# Check that we can distiguish the pathological case of a string, and the -# utf8 representation of that string. -my $pound_bytes = my $pound_utf8 = $pound . '1'; -utf8::encode ($pound_bytes); - -my @names = ("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); " - . "SvIVX(temp_sv) = 1149;"}, - {name=>"perl", type=>"PV",}, -); + 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; + } -push @names, $_ foreach keys %compass; + closedir DIR or warn "closedir '.': $!"; + if ($fail) { + print "not ok $realtest\n"; + } else { + print "ok $realtest\n"; + } + $realtest++; +} -# Automatically compile the list of all the macro names, and make them -# exported constants. -my @names_only = map {(ref $_) ? $_->{name} : $_} @names; +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++; -# Exporter::Heavy (currently) isn't able to export these names: -push @names, ({name=>"*/", type=>"PV", value=>'"CLOSE"', macro=>1}, - {name=>"/*", type=>"PV", value=>'"OPEN"', macro=>1}, - {name=>$pound, type=>"PV", value=>'"Sterling"', macro=>1}, - {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}, - ); + if (-f "$makefile$makefile_ext") { + print "ok $realtest\n"; + } else { + print "not ok $realtest\n"; + } + $realtest++; -=pod + my @makeout; -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): + if ($^O eq 'VMS') { $make .= ' all'; } -nick@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 + print "# make = '$make'\n"; + @makeout = `$make`; + if ($?) { + print "not ok $realtest # $make failed: $?\n"; + print "# $_" foreach @makeout; + exit($?); + } else { + print "ok $realtest\n"; + } + $realtest++; -=cut + if ($^O eq 'VMS') { $make =~ s{ all}{}; } -my $types = {}; -my $constant_types = constant_types(); # macro defs -my $C_constant = join "\n", - C_constant ($package, undef, "IV", $types, undef, undef, @names); -my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant - -################ Header -my $header = catfile($dir, "test.h"); -push @files, "test.h"; -open FH, ">$header" or die "open >$header: $!\n"; -print FH <<"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 + 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++; -while (my ($point, $bearing) = each %compass) { - print FH "#define $point $bearing\n" + 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 + or die "Can't rename '$makefile_rename' to '$makefile': $!"; + + 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 ('.', '.', '..'); } -close FH or die "close $header: $!\n"; -################ XS -my $xs = catfile($dir, "$package.xs"); -push @files, "$package.xs"; -open FH, ">$xs" or die "open >$xs: $!\n"; +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 -print FH <<'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 -print FH "#include \"test.h\"\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"; + # 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 = catfile($dir, "$package.pm"); -push @files, "$package.pm"; -open FH, ">$pm" or die "open >$pm: $!\n"; -print FH "package $package;\n"; -print FH "use $];\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'; + print FH <<'EOT'; use strict; EOT -printf FH "use warnings;\n" unless $] < 5.006; -print FH <<'EOT'; + printf FH "use warnings;\n" unless $] < 5.006; + print FH <<'EOT'; use Carp; require Exporter; @@ -194,47 +352,156 @@ use vars qw ($VERSION @ISA @EXPORT_OK $AUTOLOAD); $VERSION = '0.01'; @ISA = qw(Exporter DynaLoader); -@EXPORT_OK = qw( 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 the names of all our autoloaded constants -print FH "\t$_\n" foreach (@names_only); -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 = catfile($dir, "test.pl"); -push @files, "test.pl"; -open FH, ">$testpl" or die "open >$testpl: $!\n"; - -print FH "use strict;\n"; -print FH "use $package qw(@names_only);\n"; -print FH <<"EOT"; - -use utf8; - -print "1..1\n"; +print "1..2\n"; if (open OUTPUT, ">$output") { print "ok 1\n"; select OUTPUT; } else { - print "not ok 1 # Failed to open '$output': $!\n"; + 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 -print FH << '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); " + . "SvIVX(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"; + print "not ok 5 # \$five\n"; } # PV @@ -323,7 +590,6 @@ unless (defined $undef) { 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) { @@ -348,10 +614,10 @@ my %compass = ( EOT while (my ($point, $bearing) = each %compass) { - print FH "'$point' => $bearing, " + $test_body .= "'$point' => $bearing, " } -print FH <<'EOT'; +$test_body .= <<'EOT'; ); @@ -377,7 +643,7 @@ if ($fail) { EOT -print FH <<"EOT"; +$test_body .= <<"EOT"; my \$rfc1149 = RFC1149; if (\$rfc1149 ne "$parent_rfc1149") { print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n"; @@ -393,7 +659,7 @@ if (\$rfc1149 != 1149) { EOT -print FH <<'EOT'; +$test_body .= <<'EOT'; # test macro=>1 my $open = OPEN; if ($open eq '/*') { @@ -402,26 +668,80 @@ if ($open eq '/*') { 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); -# 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*", $_) . "'"} - ($pound, $inf, $pound_bytes, $pound_utf8); -# Values is a list of strings, such as ('194,163,49', '163,49') + $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*"; + } -print FH <<'EOT'; + 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}, + ); -# I can see that this child test program might be about to use parts of -# Test::Builder +=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@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 $test = 23; my ($pound, $inf, $pound_bytes, $pound_utf8) = map {eval "pack 'U*', $_"} EOT -print FH join ",", @values; + $test_body .= join ",", @values; -print FH << 'EOT'; + $test_body .= << 'EOT'; ; foreach (["perl", "rules", "rules"], @@ -437,12 +757,19 @@ foreach (["perl", "rules", "rules"], (my $name = $string) =~ s/([^ -~])/sprintf '\x{%X}', ord $1/ges; print "# \"$name\" => \'$expect\'\n"; # Try to force this to be bytes if possible. - utf8::downgrade ($string, 1); + 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 -print FH "my (\$error, \$got) = ${package}::constant (\$string);\n"; + $test_body .= "my (\$error, \$got) = ${package}::constant (\$string);\n"; -print FH <<'EOT'; + $test_body .= <<'EOT'; if ($error or $got ne $expect) { print "not ok $test # error '$error', got '$got'\n"; } else { @@ -450,12 +777,16 @@ print FH <<'EOT'; } $test++; print "# Now upgrade '$name' to utf8\n"; - utf8::upgrade ($string); + if ($better_than_56) { + utf8::upgrade ($string); + } else { + $string = pack ('U*') . $string; + } EOT -print FH "my (\$error, \$got) = ${package}::constant (\$string);\n"; + $test_body .= "my (\$error, \$got) = ${package}::constant (\$string);\n"; -print FH <<'EOT'; + $test_body .= <<'EOT'; if ($error or $got ne $expect) { print "not ok $test # error '$error', got '$got'\n"; } else { @@ -465,12 +796,16 @@ print FH <<'EOT'; if (defined $expect_bytes) { print "# And now with the utf8 byte sequence for name\n"; # Try the encoded bytes. - utf8::encode ($string); + if ($better_than_56) { + utf8::encode ($string); + } else { + $string = pack 'C*', unpack 'C*', $string . pack "U*"; + } EOT -print FH "my (\$error, \$got) = ${package}::constant (\$string);\n"; + $test_body .= "my (\$error, \$got) = ${package}::constant (\$string);\n"; -print FH <<'EOT'; + $test_body .= <<'EOT'; if (ref $expect_bytes) { # Error expected. if ($error) { @@ -488,216 +823,100 @@ print FH <<'EOT'; } EOT -close FH or die "close $testpl: $!\n"; - -# This is where the test numbers carry on after the test number above are -# relayed -my $test = 44; - -################ 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 = catfile($dir, "Makefile.PL"); -push @files, "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"; - -################ MANIFEST -# We really need a MANIFEST because make distclean checks it. -my $manifest = catfile($dir, "MANIFEST"); -push @files, "MANIFEST"; -open FH, ">$manifest" or die "open >$manifest: $!\n"; -print FH "$_\n" foreach @files; -close FH or die "close $manifest: $!\n"; - -chdir $dir or die $!; push @INC, '../../lib'; -END {chdir ".." or warn $!}; - -my @perlout = `$runperl Makefile.PL PERL_CORE=1`; -if ($?) { - print "not ok 1 # $runperl Makefile.PL failed: $?\n"; - print "# $_" foreach @perlout; - exit($?); -} else { - print "ok 1\n"; -} - - -my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile'); -my $makefile_ext = ($^O eq 'VMS' ? '.mms' : ''); -if (-f "$makefile$makefile_ext") { - print "ok 2\n"; -} else { - print "not ok 2\n"; -} - -# Renamed by make clean -my $makefile_rename = $makefile . ($^O eq 'VMS' ? '.mms' : '.old'); - -my $make = $Config{make}; - -$make = $ENV{MAKE} if exists $ENV{MAKE}; - -if ($^O eq 'MSWin32' && $make eq 'nmake') { $make .= " -nologo"; } - -my @makeout; - -if ($^O eq 'VMS') { $make .= ' all'; } -print "# make = '$make'\n"; -@makeout = `$make`; -if ($?) { - print "not ok 3 # $make failed: $?\n"; - print "# $_" foreach @makeout; - exit($?); -} else { - print "ok 3\n"; + end_tests("utf8 tests", \@items, [], "#define perl \"rules\"\n", $test_body); } -if ($^O eq 'VMS') { $make =~ s{ all}{}; } +# 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 ($Config{usedl}) { - print "ok 4\n"; -} else { - my $makeperl = "$make perl"; - print "# make = '$makeperl'\n"; - @makeout = `$makeperl`; - if ($?) { - print "not ok 4 # $makeperl failed: $?\n"; - print "# $_" foreach @makeout; - exit($?); + 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 "ok 4\n"; + print "not ok $dummytest # expected error, got no error and '\$got'\n"; } +EOT + } + $dummytest++; + return $test_body . <<'EOT'; } - -my $maketest = "$make test"; -print "# make = '$maketest'\n"; - -@makeout = `$maketest`; - -if (open OUTPUT, "<$output") { - print while <OUTPUT>; - close OUTPUT or print "# Close $output failed: $!\n"; -} else { - # Harness will report missing test results at this point. - print "# Open <$output failed: $!\n"; +EOT } -if ($?) { - print "not ok $test # $maketest failed: $?\n"; - print "# $_" foreach @makeout; +# 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 "ok $test - maketest\n"; + print "not ok $dummytest # $thisname gave \$value\n"; } -$test++; - - -# -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; +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); } - close XS; close REGENTMP; - $regen = `$runperl regentmp`; - unlink 'regentmp'; -} -else { - $regen = `$runperl -x $package.xs`; -} -if ($?) { - print "not ok $test # $runperl -x $package.xs failed: $?\n"; -} else { - print "ok $test - regen\n"; -} -$test++; - -my $expect = $constant_types . $C_constant . - "\n#### XS Section:\n" . $XS_constant; - -if ($expect eq $regen) { - print "ok $test - regen worked\n"; -} else { - print "not ok $test - regen worked\n"; - # open FOO, ">expect"; print FOO $expect; - # open FOO, ">regen"; print FOO $regen; close FOO; -} -$test++; - -my $makeclean = "$make clean"; -print "# make = '$makeclean'\n"; -@makeout = `$makeclean`; -if ($?) { - print "not ok $test # $make failed: $?\n"; - print "# $_" foreach @makeout; -} else { - print "ok $test\n"; -} -$test++; - -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 $test\n"; - } else { - print "ok $test\n"; - } - $test++; + # 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_for_bonus_files ('.', @files, $output, $makefile_rename, '.', '..'); +# 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)); -rename $makefile_rename, $makefile - or die "Can't rename '$makefile_rename' to '$makefile': $!"; -unlink $output or warn "Can't unlink '$output': $!"; +# Need this if the single test below is rolled into @tests : +# --$dummytest; +print "1..$dummytest\n"; -# Need to make distclean to remove ../../lib/ExtTest.pm -my $makedistclean = "$make distclean"; -print "# make = '$makedistclean'\n"; -@makeout = `$makedistclean`; -if ($?) { - print "not ok $test # $make failed: $?\n"; - print "# $_" foreach @makeout; -} else { - print "ok $test\n"; -} -$test++; - -check_for_bonus_files ('.', @files, '.', '..'); +write_and_run_extension @$_ foreach @tests; -unless ($keep_files) { - foreach (@files) { - unlink $_ or warn "unlink $_: $!"; - } -} +# 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++; -check_for_bonus_files ('.', '.', '..'); +print STDERR "# You were running with \$keep_files set to $keep_files\n" + if $keep_files; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Embed.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Embed.t index 5460a254bd6..fc0ed3cbc17 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/Embed.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Embed.t @@ -102,7 +102,7 @@ if ($^O eq 'VMS') { # Everyone needs libperl copied if it's not found by '-lperl'. $testlib = $Config{'libperl'}; my $srclib = $testlib; - $testlib =~ s/^[^.]+/libperl/; + $testlib =~ s/.+(?=\.[^.]*)/libperl/; $testlib = File::Spec::->catfile($lib, $testlib); $srclib = File::Spec::->catfile($lib, $srclib); if (-f $srclib) { @@ -151,11 +151,15 @@ __END__ #define my_puts(a) if(puts(a) < 0) exit(666) -static char *cmds[] = { "perl","-e", "print qq[ok 5\\n]", NULL }; +static char *cmds[] = { "perl","-e", "$|=1; print qq[ok 5\\n]", NULL }; int main(int argc, char **argv, char **env) { - PerlInterpreter *my_perl = perl_alloc(); + PerlInterpreter *my_perl; + + PERL_SYS_INIT3(&argc,&argv,&env); + + my_perl = perl_alloc(); my_puts("ok 2"); @@ -181,5 +185,7 @@ int main(int argc, char **argv, char **env) my_puts("ok 8"); + PERL_SYS_TERM(); + return 0; } diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/INST.t b/gnu/usr.bin/perl/lib/ExtUtils/t/INST.t index d6780ac6744..3639acd11b3 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/INST.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/INST.t @@ -60,7 +60,7 @@ is( $mm->{VERSION}, 0.01, 'VERSION' ); my $config_prefix = $Config{installprefixexp} || $Config{installprefix} || $Config{prefixexp} || $Config{prefix}; -is( $mm->{PREFIX}, $config_prefix, 'PREFIX' ); +is( $mm->{PERLPREFIX}, $config_prefix, 'PERLPREFIX' ); is( !!$mm->{PERL_CORE}, !!$ENV{PERL_CORE}, 'PERL_CORE' ); diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/INST_PREFIX.t b/gnu/usr.bin/perl/lib/ExtUtils/t/INST_PREFIX.t index 8af8c307fa8..2d90a8c472a 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/INST_PREFIX.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/INST_PREFIX.t @@ -16,7 +16,7 @@ BEGIN { } use strict; -use Test::More tests => 26; +use Test::More tests => 36; use MakeMaker::Test::Utils; use ExtUtils::MakeMaker; use File::Spec; @@ -38,15 +38,15 @@ my $Updir = File::Spec->updir; ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); -my $PREFIX = File::Spec->catdir('foo', 'bar'); 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, ); + like( $stdout->read, qr{ Writing\ $Makefile\ for\ Big::Liar\n Big::Liar's\ vars\n @@ -54,16 +54,41 @@ like( $stdout->read, qr{ 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' ); +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); @@ -80,41 +105,36 @@ is( $mm_perl_src, $perl_src, 'PERL_SRC' ); # Every INSTALL* variable must start with some PREFIX. -my @Perl_Install = qw(archlib privlib bin script - man1dir man3dir); -my @Site_Install = qw(sitearch sitelib sitebin - siteman1dir siteman3dir); -my @Vend_Install = qw(vendorarch vendorlib vendorbin - vendorman1dir vendorman3dir); - -foreach my $var (@Perl_Install) { - my $prefix = $Is_VMS ? '[.foo.bar' : File::Spec->catdir(qw(foo bar)); - - # support for man page skipping - $prefix = 'none' if $var =~ /man/ && !$Config{"install$var"}; - like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, "PREFIX + $var" ); -} +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)] +); -foreach my $var (@Site_Install) { - my $prefix = $Is_VMS ? '[.foo.bar' : File::Spec->catdir(qw(foo bar)); +while( my($type, $vars) = each %Install_Vars) { - like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, - "SITEPREFIX + $var" ); -} + SKIP: foreach my $var (@$vars) { + skip "VMS must expand macros in INSTALL* vars", scalar @$vars + if $Is_VMS; -foreach my $var (@Vend_Install) { - my $prefix = $Is_VMS ? '[.foo.bar' : File::Spec->catdir(qw(foo bar)); + my $prefix = '$('.$type.'PREFIX)'; - like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, - "VENDORPREFIX + $var" ); + # support for man page skipping + $prefix = 'none' if $type eq 'PERL' && + $var =~ /man/ && + !$Config{"install$var"}; + like( $mm->{uc "install$var"}, qr/^\Q$prefix\E/, "$prefix + $var" ); + } } - # Check that when installman*dir isn't set in Config no man pages # are generated. { undef *ExtUtils::MM_Unix::Config; + undef *ExtUtils::MM_Unix::Config_Override; %ExtUtils::MM_Unix::Config = %Config; + *ExtUtils::MM_VMS::Config = \%ExtUtils::MM_Unix::Config; + $ExtUtils::MM_Unix::Config{installman1dir} = ''; $ExtUtils::MM_Unix::Config{installman3dir} = ''; @@ -132,3 +152,37 @@ foreach my $var (@Vend_Install) { is( $mm->{INSTALLMAN1DIR}, $wibble ); is( $mm->{INSTALLMAN3DIR}, 'none' ); } + +# Check that when installvendorman*dir is set in Config it is honored +# [rt.cpan.org 2949] +{ + undef *ExtUtils::MM_Unix::Config; + undef *ExtUtils::MM_Unix::Config_Override; + undef *ExtUtils::MM_VMS::Config; + + %ExtUtils::MM_Unix::Config = %Config; + *ExtUtils::MM_VMS::Config = \%ExtUtils::MM_Unix::Config; + + $ExtUtils::MM_Unix::Config{installvendorman1dir} = + File::Spec->catdir('foo','bar'); + $ExtUtils::MM_Unix::Config{installvendorman3dir} = ''; + $ExtUtils::MM_Unix::Config{usevendorprefix} = 1; + $ExtUtils::MM_Unix::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' ); +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Install.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Install.t new file mode 100644 index 00000000000..13b3a6779ca --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Install.t @@ -0,0 +1,112 @@ +#!/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 => 29; + +BEGIN { use_ok('ExtUtils::Install') } + +# Check exports. +foreach my $func (qw(install uninstall pm_to_blib install_default)) { + can_ok(__PACKAGE__, $func); +} + + +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' ); +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Installed.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Installed.t index d62afba4348..30dfcb3d66b 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/Installed.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Installed.t @@ -9,7 +9,9 @@ BEGIN { unshift @INC, 't/lib/'; } } -chdir 't'; + +my $Is_VMS = $^O eq 'VMS'; +chdir($Is_VMS ? 'BFD_TEST_ROOT:[t]' : 't'); use strict; @@ -54,7 +56,7 @@ 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 $^O eq 'VMS'; +$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'; @@ -80,11 +82,9 @@ ok( !$ei->_is_under('foo', @under), '... should find no file not under dirs'); ok( $ei->_is_under('baz', @under), '... should find file under dir' ); -my $wrotelist; - rmtree 'auto/FakeMod'; ok( mkpath('auto/FakeMod') ); -END { rmtree 'auto/FakeMod' } +END { rmtree 'auto' } ok(open(PACKLIST, '>auto/FakeMod/.packlist')); print PACKLIST 'list'; @@ -230,14 +230,6 @@ is( ${ $ei->packlist('yesmod') }, 102, is( $ei->version('yesmod'), 101, 'version() should report installed mod version' ); -END { - if ($wrotelist) { - for my $file (qw( .packlist FakePak.pm )) { - 1 while unlink $file; - } - File::Path::rmtree('auto') or warn "Couldn't rmtree auto: $!"; - } -} package Fakepak; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Liblist.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Liblist.t new file mode 100644 index 00000000000..0ee90be2eed --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Liblist.t @@ -0,0 +1,36 @@ +#!/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; +use Data::Dumper; + +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 Dumper @warn; +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Any.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Any.t new file mode 100644 index 00000000000..0326274fe70 --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Any.t @@ -0,0 +1,33 @@ +#!/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' ); + diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_BeOS.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_BeOS.t index 870e8d47fe7..3161176cadf 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_BeOS.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_BeOS.t @@ -40,9 +40,16 @@ use File::Basename; require_ok( 'ExtUtils::MM_BeOS' ); -# perl_archive() + +# init_linker { - my $libperl = $Config{libperl} || 'libperl.a'; - is( MM->perl_archive(), File::Spec->catfile('$(PERL_INC)', $libperl ), - 'perl_archive() should respect libperl setting' ); + 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' ); } diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Cygwin.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Cygwin.t index 03641d33f22..5b0b04f6c63 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Cygwin.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Cygwin.t @@ -11,11 +11,12 @@ BEGIN { } chdir 't'; +use strict; use Test::More; BEGIN { if ($^O =~ /cygwin/i) { - plan tests => 13; + plan tests => 11; } else { plan skip_all => "This is not cygwin"; } @@ -33,83 +34,69 @@ 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 $args = bless({ +my $MM = bless({ CFLAGS => 'fakeflags', CCFLAGS => '', -}, MM); +}, 'MM'); # with CFLAGS set, it should be returned -is( $args->cflags(), 'fakeflags', +is( $MM->cflags(), 'fakeflags', 'cflags() should return CFLAGS member data, if set' ); -delete $args->{CFLAGS}; +delete $MM->{CFLAGS}; # ExtUtils::MM_Cygwin::cflags() calls this, fake the output { local $SIG{__WARN__} = sub { - # no warnings 'redefine'; warn @_ unless $_[0] =~ /^Subroutine .* redefined/; }; - sub ExtUtils::MM_Unix::cflags { return $_[1] }; + *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 $args->{NEEDS_LINKING} = 1; - $args->cflags(<<FLAGS); + local $MM->{NEEDS_LINKING} = 1; + $MM->cflags(<<FLAGS); OPTIMIZE = opt PERLTYPE =pt FLAGS } -like( $args->{CFLAGS}, qr/OPTIMIZE = opt/, '... should set OPTIMIZE' ); -like( $args->{CFLAGS}, qr/PERLTYPE = pt/, '... should set PERLTYPE' ); -like( $args->{CFLAGS}, qr/CCFLAGS = $ccflags/, '... should set CCFLAGS' ); +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 -$args = bless({ +$MM = bless({ NOECHO => 'noecho', MAN3PODS => {}, MAN1PODS => {}, MAKEFILE => 'Makefile', }, 'MM'); -like( $args->manifypods(), qr/pure_all\n\tnoecho/, +unlike( $MM->manifypods(), qr/foo/, 'manifypods() should return without PODS values set' ); -$args->{MAN3PODS} = { foo => 1 }; -my $out = tie *STDOUT, 'FakeOut'; +$MM->{MAN3PODS} = { foo => 'foo.1' }; +my $res = $MM->manifypods(); +like( $res, qr/pure_all.*foo.*foo.1/s, '... should add MAN3PODS targets' ); + + +# init_linker { - local $SIG{__WARN__} = sub { - # no warnings 'redefine'; - warn @_ unless $_[0] =~ /used only once/; - }; - no warnings 'once'; - local *MM::perl_script = sub { return }; - my $res = $args->manifypods(); - like( $$out, qr/could not locate your pod2man/, - '... should warn if pod2man cannot be located' ); - like( $res, qr/POD2MAN_EXE = -S pod2man/, - '... should use default pod2man target' ); - like( $res, qr/pure_all.+foo/, '... should add MAN3PODS targets' ); -} + my $libperl = $Config{libperl} || 'libperl.a'; + $libperl =~ s/\.a/.dll.a/ if $] >= 5.007; + $libperl = "\$(PERL_INC)/$libperl"; + + my $export = ''; + my $after = ''; + $MM->init_linker; -SKIP: { - skip "Only relevent in the core", 2 unless $ENV{PERL_CORE}; - $args->{PERL_SRC} = File::Spec->updir; - $args->{MAN1PODS} = { bar => 1 }; - $$out = ''; - $res = $args->manifypods(); - is( $$out, '', '... should not warn if PERL_SRC provided' ); - like( $res, qr/bar \\\n\t1 \\\n\tfoo/, - '... should join MAN1PODS and MAN3PODS'); + is( $MM->{PERL_ARCHIVE}, $libperl, 'PERL_ARCHIVE' ); + is( $MM->{PERL_ARCHIVE_AFTER}, $after, 'PERL_ARCHIVE_AFTER' ); + is( $MM->{EXPORT_LIST}, $export, 'EXPORT_LIST' ); } -# test perl_archive -my $libperl = $Config{libperl} || 'libperl.a'; -$libperl =~ s/\.a/.dll.a/; -is( $args->perl_archive(), "\$(PERL_INC)/$libperl", - 'perl_archive() should respect libperl setting' ); package FakeOut; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_NW5.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_NW5.t index d2046eeebbf..13359d17fbc 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_NW5.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_NW5.t @@ -172,19 +172,20 @@ delete $ENV{PATH} unless $had_path; 'clean() Makefile target' ); } -# perl_archive() + +# init_linker { my $libperl = $Config{libperl} || 'libperl.a'; - is( $MM->perl_archive(), File::Spec->catfile('$(PERL_INC)', $libperl ), - 'perl_archive() should respect libperl setting' ); -} + my $export = '$(BASEEXT).def'; + my $after = ''; + $MM->init_linker; -# export_list -{ - my $mm_w32 = bless { BASEEXT => 'someext' }, 'MM'; - is( $mm_w32->export_list(), 'someext.def', 'export_list()' ); + 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'; @@ -272,14 +273,6 @@ unlink "${script_name}$script_ext" if -f "${script_name}$script_ext"; # xs_o() should look into that # top_targets() should look into that -# manifypods() -{ - my $mm_w32 = bless { NOECHO => '' }, 'MM'; - like( $mm_w32->manifypods(), - qr/^\nmanifypods :\n\t\$\Q(NOOP)\E\n$/, - 'manifypods() Makefile target' ); -} - # dist_ci() should look into that # dist_core() should look into that diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_OS2.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_OS2.t index 53b83f3f855..c09f68a4473 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_OS2.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_OS2.t @@ -247,26 +247,30 @@ ok( ExtUtils::MM_OS2->file_name_is_absolute( '\foo' ), ok( ! ExtUtils::MM_OS2->file_name_is_absolute( 'arduk' ), '... but not for paths with no leading slash or volume' ); -# perl_archive -is( ExtUtils::MM_OS2->perl_archive(), '$(PERL_INC)/libperl$(LIB_EXT)', - 'perl_archive() should return a static string' ); -# perl_archive_after +$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; - isnt( ExtUtils::MM_OS2->perl_archive_after(), '', - 'perl_archive_after() should return string without $is_aout set' ); + $mm->init_linker; + isnt( $mm->{PERL_ARCHIVE_AFTER}, '', + 'PERL_ARCHIVE_AFTER should be empty without $is_aout set' ); $aout = 1; - is( ExtUtils::MM_OS2->perl_archive_after(), '', - '... and blank string if it is set' ); + is( $mm->{PERL_ARCHIVE_AFTER}, + '$(PERL_INC)/libperl_override$(LIB_EXT)', + '... and has libperl_override if it is set' ); } -# export_list -is( ExtUtils::MM_OS2::export_list({ BASEEXT => 'foo' }), 'foo.def', - 'export_list() should add .def to BASEEXT member' ); +# EXPORT_LIST +is( $mm->{EXPORT_LIST}, '$(BASEEXT).def', + 'EXPORT_LIST should add .def to BASEEXT member' ); END { use File::Path; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Unix.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Unix.t index 1e47f1bc370..6683761995b 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Unix.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Unix.t @@ -2,7 +2,7 @@ BEGIN { if( $ENV{PERL_CORE} ) { - chdir 't' if -d 't'; + chdir 't'; @INC = '../lib'; } else { @@ -18,7 +18,7 @@ BEGIN { plan skip_all => 'Non-Unix platform'; } else { - plan tests => 112; + plan tests => 115; } } @@ -79,14 +79,13 @@ foreach ( qw / dist_basics dist_ci dist_core - dist_dir + distdir dist_test dlsyms dynamic dynamic_bs dynamic_lib exescan - export_list extliblist find_perl fixin @@ -103,7 +102,6 @@ foreach ( qw / makeaperl makefile manifypods - maybe_command_in_dirs needs_linking pasthru perldepend @@ -129,7 +127,6 @@ foreach ( qw / xs_c xs_cpp xs_o - xsubpp_version / ) { can_ok($class, $_); @@ -165,10 +162,14 @@ is ($t->has_link_code(),1); is ($t->{HAS_LINK_CODE},1); ############################################################################### # libscan -is ($t->libscan('RCS'),'','libscan on RCS'); -is ($t->libscan('CVS'),'','libscan on CVS'); -is ($t->libscan('SCCS'),'','libscan on SCCS'); -is ($t->libscan('Fatty'),'Fatty','libscan on something not RCS, CVS or SCCS'); +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 @@ -214,6 +215,7 @@ 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'); @@ -231,12 +233,13 @@ foreach (qw/ post_constants postamble post_initialize/) is ($t->replace_manpage_separator('Foo/Bar'),'Foo::Bar','manpage_separator'); ############################################################################### -# export_list, perl_archive, perl_archive_after -foreach (qw/ export_list perl_archive perl_archive_after/) - { - is ($t->$_(),'',"$_() is empty string on Unix"); - } +$t->init_linker; +foreach (qw/ EXPORT_LIST PERL_ARCHIVE PERL_ARCHIVE_AFTER /) +{ + ok( exists $t->{$_}, "$_ was defined" ); + is( $t->{$_}, '', "$_ is empty on Unix"); +} { diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_VMS.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_VMS.t index 303a599798d..dcc5ed6230a 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_VMS.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_VMS.t @@ -19,7 +19,6 @@ BEGIN { find_perl path maybe_command - maybe_command_in_dirs perl_script file_name_is_absolute replace_manpage_separator @@ -30,7 +29,6 @@ BEGIN { pm_to_blib tool_autosplit tool_xsubpp - xsubpp_version tools_other dist c_o @@ -49,7 +47,7 @@ BEGIN { realclean dist_basics dist_core - dist_dir + distdir dist_test install perldepend diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Win32.t b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Win32.t index 8e2b52c03c4..e980b1a84e6 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Win32.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/MM_Win32.t @@ -16,7 +16,7 @@ use Test::More; BEGIN { if ($^O =~ /MSWin32/i) { - plan tests => 40; + plan tests => 42; } else { plan skip_all => 'This is not Win32'; } @@ -84,7 +84,7 @@ delete $ENV{PATHEXT} unless $had_pathext; { my $my_perl = $1 if $^X =~ /(.*)/; # are we in -T or -t? my( $perl, $path ) = fileparse( $my_perl ); - like( $MM->find_perl( $], [ $perl ], [ $path ] ), + like( $MM->find_perl( $], [ $perl ], [ $path ], 0 ), qr/^\Q$my_perl\E$/i, 'find_perl() finds this perl' ); } @@ -112,7 +112,7 @@ delete $ENV{PATHEXT} unless $had_pathext; # 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' ); + 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 ); @@ -122,32 +122,44 @@ delete $ENV{PATHEXT} unless $had_pathext; } # 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', - VERSION_FROM => 'TestMM_Win32', PM => { 'MM_Win32.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} = ''; - } + @{$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}} ); - like( $mm_w32->constants(), - qr|^NAME\ =\ TestMM_Win32\s+VERSION\ =\ 1\.00.+ - MAKEMAKER\ =\ \Q$INC{'ExtUtils/MakeMaker.pm'}\E\s+ - MM_VERSION\ =\ \Q$ExtUtils::MakeMaker::VERSION\E.+ - VERSION_FROM\ =\ TestMM_Win32.+ - TO_INST_PM\ =\ \Q$s_PM\E\s+ - PM_TO_BLIB\ =\ \Q$k_PM\E - |xs, 'constants()' ); - + 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() @@ -172,17 +184,17 @@ delete $ENV{PATH} unless $had_path; 'clean() Makefile target' ); } -# perl_archive() +# init_linker { - my $libperl = $Config{libperl} || 'libperl.a'; - is( $MM->perl_archive(), File::Spec->catfile('$(PERL_INC)', $libperl ), - 'perl_archive() should respect libperl setting' ); -} - -# export_list -{ - my $mm_w32 = bless { BASEEXT => 'someext' }, 'MM'; - is( $mm_w32->export_list(), 'someext.def', 'export_list()' ); + 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() @@ -234,52 +246,9 @@ EOSCRIPT 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 -# manifypods() -{ - my $mm_w32 = bless { NOECHO => '' }, 'MM'; - like( $mm_w32->manifypods(), - qr/^\nmanifypods :\n\t\$\Q(NOOP)\E\n$/, - 'manifypods() Makefile target' ); -} - # dist_ci() should look into that # dist_core() should look into that diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/Manifest.t b/gnu/usr.bin/perl/lib/ExtUtils/t/Manifest.t index 7a488be0937..215a24b14e4 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/Manifest.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/Manifest.t @@ -14,7 +14,7 @@ chdir 't'; use strict; # these files help the test run -use Test::More tests => 33; +use Test::More tests => 41; use Cwd; # these files are needed for the module itself @@ -26,14 +26,14 @@ use File::Path; @INC = map { File::Spec->rel2abs($_) } @INC; # keep track of everything added so it can all be deleted -my %files; +my %Files; sub add_file { - my ($file, $data) = @_; - $data ||= 'foo'; - unlink $file; # or else we'll get multiple versions on VMS - open( T, '>'.$file) or return; - print T $data; - ++$files{$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; } @@ -58,7 +58,7 @@ sub remove_dir { BEGIN { use_ok( 'ExtUtils::Manifest', qw( mkmanifest manicheck filecheck fullcheck - maniread manicopy skipcheck ) ); + maniread manicopy skipcheck maniadd) ); } my $cwd = Cwd::getcwd(); @@ -127,10 +127,12 @@ 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 $_} ); # poison the manifest, and add a comment that should be reported add_file( 'MANIFEST', 'none #none' ); @@ -158,7 +160,7 @@ like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' ); 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'}++; + $Files{'albatross'}++; } @@ -173,21 +175,59 @@ 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' ); +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 { - # the args are evaluated in scalar context - is( unlink( keys %files ), keys %files, 'remove all added files' ); + 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' ); - unlink('mantest/MANIFEST'); remove_dir( 'mantest' ); } diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/basic.t b/gnu/usr.bin/perl/lib/ExtUtils/t/basic.t index 9080434333c..960a75dfdf9 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/basic.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/basic.t @@ -14,40 +14,22 @@ BEGIN { } use strict; -use Test::More tests => 17; +use Config; + +use Test::More tests => 73; use MakeMaker::Test::Utils; +use File::Find; use File::Spec; -use TieOut; +use File::Path; -my $perl = which_perl(); +# 'make disttest' sets a bunch of environment variables which interfere +# with our testing. +delete @ENV{qw(PREFIX LIB MAKEFLAGS)}; -my $root_dir = 't'; - -if( $^O eq 'VMS' ) { - # On older systems we might exceed the 8-level directory depth limit - # imposed by RMS. We get around this with a rooted logical, but we - # can't create logical names with attributes in Perl, so we do it - # in a DCL subprocess and put it in the job table so the parent sees it. - open( BFDTMP, '>bfdtesttmp.com' ) || die "Error creating command file; $!"; - print BFDTMP <<'COMMAND'; -$ IF F$TRNLNM("PERL_CORE") .EQS. "" .AND. F$TYPE(PERL_CORE) .EQS. "" -$ THEN -$! building CPAN version -$ BFD_TEST_ROOT = F$PARSE("SYS$DISK:[]",,,,"NO_CONCEAL")-".][000000"-"]["-"].;"+".]" -$ ELSE -$! we're in the core -$ BFD_TEST_ROOT = F$PARSE("SYS$DISK:[-]",,,,"NO_CONCEAL")-".][000000"-"]["-"].;"+".]" -$ ENDIF -$ DEFINE/JOB/NOLOG/TRANSLATION=CONCEALED BFD_TEST_ROOT 'BFD_TEST_ROOT' -COMMAND - close BFDTMP; - - system '@bfdtesttmp.com'; - END { 1 while unlink 'bfdtesttmp.com' } - $root_dir = 'BFD_TEST_ROOT:[t]'; -} +my $perl = which_perl(); +my $Is_VMS = $^O eq 'VMS'; -chdir $root_dir; +chdir($Is_VMS ? 'BFD_TEST_ROOT:[t]' : 't'); perl_lib; @@ -56,10 +38,11 @@ my $Touch_Time = calibrate_mtime(); $| = 1; -ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || +ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); -my @mpl_out = `$perl Makefile.PL PREFIX=dummy-install`; +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); @@ -86,36 +69,188 @@ my $make = make_run(); { # Supress 'make manifest' noise local $ENV{PERL_MM_MANIFEST_VERBOSE} = 0; - my $manifest_out = `$make manifest`; + my $manifest_out = run("$make manifest"); ok( -e 'MANIFEST', 'make manifest created a MANIFEST' ); ok( -s 'MANIFEST', ' its not empty' ); } END { unlink 'MANIFEST'; } -my $test_out = `$make test`; + +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 ); +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 = `$make_test_verbose`; +$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 ); +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 + $files{lc $_} = $File::Find::name; +}, '../dummy-install' ); +ok( $files{'dummy.pm'}, ' Dummy.pm installed' ); +ok( $files{'liar.pm'}, ' Liar.pm installed' ); +ok( $files{'.packlist'}, ' packlist created' ); +ok( $files{'perllocal.pod'},' perllocal.pod created' ); + + +SKIP: { + skip "VMS install targets do not preserve $(PREFIX)", 8 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{'.packlist'}, ' packlist created' ); + ok( $files{'perllocal.pod'},' perllocal.pod created' ); + rmtree('elsewhere'); +} + + +SKIP: { + skip "VMS install targets do not preserve $(DESTDIR)", 10 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{'.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)", 9 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{'.packlist'}, ' packlist created' ); + ok( $files{'perllocal.pod'},' perllocal.pod created' ); + rmtree('other'); +} + -my $dist_test_out = `$make disttest`; +my $dist_test_out = run("$make disttest"); is( $?, 0, 'disttest' ) || diag($dist_test_out); +# Test META.yml generation +use ExtUtils::Manifest qw(maniread); +ok( -f 'META.yml', 'META.yml written' ); +my $manifest = maniread(); +# 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 $metafile_out = run("$make metafile"); +is( $?, 0, 'metafile' ) || diag($metafile_out); +ok( !-f 'META.yml', 'META.yml generation suppressed by NO_META' ); + +# Test if MANIFEST is read-only. +chmod 0444, 'MANIFEST'; +@mpl_out = run(qq{$perl Makefile.PL}); +cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); +$metafile_out = run("$make metafile_addtomanifest"); +is( $?, 0, q{metafile_addtomanifest didn't die with locked MANIFEST} ) || + diag($metafile_out); + # Make sure init_dirscan doesn't go into the distdir -@mpl_out = `$perl Makefile.PL "PREFIX=dummy-install"`; +@mpl_out = run(qq{$perl Makefile.PL "PREFIX=../dummy-install"}); -cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || - diag(@mpl_out); +cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); -ok( grep(/^Writing $makefile for Big::Dummy/, - @mpl_out) == 1, +ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1, 'init_dirscan skipped distdir') || diag(@mpl_out); @@ -124,8 +259,18 @@ ok( grep(/^Writing $makefile for Big::Dummy/, open(SAVERR, ">&STDERR") or die $!; open(STDERR, ">".File::Spec->devnull) or die $!; -my $realclean_out = `$make realclean`; +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; + } +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/bytes.t b/gnu/usr.bin/perl/lib/ExtUtils/t/bytes.t new file mode 100644 index 00000000000..e566831cc21 --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/bytes.t @@ -0,0 +1,30 @@ +#!/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' ); +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/hints.t b/gnu/usr.bin/perl/lib/ExtUtils/t/hints.t index 62608d7bbb6..b74690fe0ab 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/hints.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/hints.t @@ -11,10 +11,16 @@ BEGIN { } 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 $hint_file = "hints/$^O.pl"; +my $hint_file = File::Spec->catfile('hints', "$^O.pl"); open(HINT, ">$hint_file") || die "Can't write dummy hints file $hint_file: $!"; print HINT <<'CLOO'; $self->{CCFLAGS} = 'basset hounds got long ears'; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/oneliner.t b/gnu/usr.bin/perl/lib/ExtUtils/t/oneliner.t new file mode 100644 index 00000000000..5e0521b45f4 --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/oneliner.t @@ -0,0 +1,51 @@ +#!/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{\$\(PERLRUN\)}{$^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. + diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/postamble.t b/gnu/usr.bin/perl/lib/ExtUtils/t/postamble.t new file mode 100644 index 00000000000..b8c049277fc --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/postamble.t @@ -0,0 +1,65 @@ +#!/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 => 5; +use MakeMaker::Test::Utils; +use ExtUtils::MakeMaker; +use TieOut; + +chdir 't'; +perl_lib; +$| = 1; + +my $Makefile = makefile_name; + +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' ); +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/prefixify.t b/gnu/usr.bin/perl/lib/ExtUtils/t/prefixify.t index 0f92a4a8b24..644bc00e8aa 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/prefixify.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/prefixify.t @@ -17,18 +17,24 @@ if( $^O eq 'VMS' ) { plan skip_all => 'prefixify works differently on VMS'; } else { - plan tests => 2; + plan tests => 3; } +use Config; use File::Spec; use ExtUtils::MM; 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'); + 'prefixify w/defaults and PREFIX'); { undef *ExtUtils::MM_Unix::Config; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/prereq_print.t b/gnu/usr.bin/perl/lib/ExtUtils/t/prereq_print.t new file mode 100644 index 00000000000..78dc6e8e1f3 --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/prereq_print.t @@ -0,0 +1,66 @@ +#!/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 tests => 8; +use MakeMaker::Test::Utils; + +# '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($Is_VMS ? 'BFD_TEST_ROOT:[t]' : 't'); +perl_lib; + +$| = 1; + +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; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/prompt.t b/gnu/usr.bin/perl/lib/ExtUtils/t/prompt.t new file mode 100644 index 00000000000..ec9aa10036e --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/prompt.t @@ -0,0 +1,56 @@ +#!/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' ); +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/recurs.t b/gnu/usr.bin/perl/lib/ExtUtils/t/recurs.t new file mode 100644 index 00000000000..9ec4f4ce28c --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/recurs.t @@ -0,0 +1,113 @@ +#!/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(); + +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 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; diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/split_command.t b/gnu/usr.bin/perl/lib/ExtUtils/t/split_command.t new file mode 100644 index 00000000000..49e2629cfbf --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/split_command.t @@ -0,0 +1,66 @@ +#!/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{\$\(PERLRUN\)}{$perl} foreach @cmds; + if( $Is_VMS ) { + s{-\n}{} foreach @cmds + } + elsif( $Is_Win32 ) { + s{\\\n}{} foreach @cmds; + } + + return map { s/\n+$//; $_ } map { `$_` } @cmds +} diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/vmsish.t b/gnu/usr.bin/perl/lib/ExtUtils/t/vmsish.t new file mode 100644 index 00000000000..6195a0d5c11 --- /dev/null +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/vmsish.t @@ -0,0 +1,17 @@ +#!/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'); + diff --git a/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t b/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t index 69738445966..1b01f0a5d02 100644 --- a/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t +++ b/gnu/usr.bin/perl/lib/ExtUtils/t/zz_cleanup_dummy.t @@ -8,14 +8,16 @@ BEGIN { unshift @INC, 't/lib'; } } -chdir 't'; +chdir($^O eq 'VMS' ? 'BFD_TEST_ROOT:[t]' : 't'); use strict; -use Test::More tests => 2; +use Test::More tests => 3; use File::Path; rmtree('Big-Dummy'); ok(!-d 'Big-Dummy', 'Big-Dummy cleaned up'); rmtree('Problem-Module'); ok(!-d 'Problem-Module', 'Problem-Module cleaned up'); +rmtree('dummy-install'); +ok(!-d 'dummy-install', 'dummy-install cleaned up'); |