Change 13733 by jhi@alpha on 2001/12/17 17:50:22
Move ExtUtils tests to lib/ExtUtils/t.
Affected files ...
.... //depot/perl/MANIFEST#673 edit
.... //depot/perl/lib/ExtUtils.t#11 delete
.... //depot/perl/lib/ExtUtils/Command.t#10 delete
.... //depot/perl/lib/ExtUtils/Embed.t#16 delete
.... //depot/perl/lib/ExtUtils/Installed.t#2 delete
.... //depot/perl/lib/ExtUtils/MM_Cygwin.t#4 delete
.... //depot/perl/lib/ExtUtils/MM_Unix.t#2 delete
.... //depot/perl/lib/ExtUtils/MM_VMS.t#4 delete
.... //depot/perl/lib/ExtUtils/Manifest.t#8 delete
.... //depot/perl/lib/ExtUtils/Mkbootstrap.t#4 delete
.... //depot/perl/lib/ExtUtils/Packlist.t#3 delete
.... //depot/perl/lib/ExtUtils/t/Command.t#1 add
.... //depot/perl/lib/ExtUtils/t/Embed.t#1 add
.... //depot/perl/lib/ExtUtils/t/ExtUtils.t#1 add
.... //depot/perl/lib/ExtUtils/t/Installed.t#1 add
.... //depot/perl/lib/ExtUtils/t/MM_Cygwin.t#1 add
.... //depot/perl/lib/ExtUtils/t/MM_Unix.t#1 add
.... //depot/perl/lib/ExtUtils/t/MM_VMS.t#1 add
.... //depot/perl/lib/ExtUtils/t/Manifest.t#1 add
.... //depot/perl/lib/ExtUtils/t/Mkbootstrap.t#1 add
.... //depot/perl/lib/ExtUtils/t/Packlist.t#1 add
.... //depot/perl/lib/ExtUtils/t/testlib.t#1 add
.... //depot/perl/lib/ExtUtils/testlib.t#2 delete
Differences ...
==== //depot/perl/MANIFEST#673 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Mon Dec 17 11:00:06 2001
+++ perl/MANIFEST Mon Dec 17 11:00:06 2001
@@ -3,8 +3,8 @@
AUTHORS Contact info for contributors
av.c Array value code
av.h Array value header
+beos/beos.c BeOS port
beos/beosish.h BeOS port
-beos/beos.c BeOS port
beos/nm.c BeOS port
bytecode.pl Produces ext/ByteLoader/byterun.h, ext/ByteLoader/byterun.c
and ext/B/Asmdata.pm
cc_runtime.h Macros need by runtime of compiler-generated code
@@ -737,8 +737,8 @@
hints/utekv.sh Hints for named architecture
hints/uts.sh Hints for named architecture
hints/uwin.sh Hints for named architecture
+hints/vmesa.sh Hints for named architecture
hints/vos.sh Hints for named architecture
-hints/vmesa.sh Hints for named architecture
hv.c Hash value code
hv.h Hash value header
INSTALL Detailed installation instructions
@@ -921,37 +921,37 @@
lib/Exporter.pm Exporter base class
lib/Exporter.t See if Exporter works
lib/Exporter/Heavy.pm Complicated routines for Exporter
-lib/ExtUtils.t See if extutils work
lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms
-lib/ExtUtils/Command.t See if ExtUtils::Command works (Win32 only)
lib/ExtUtils/Constant.pm generate XS code to import C header constants
lib/ExtUtils/Embed.pm Utilities for embedding Perl in C programs
-lib/ExtUtils/Embed.t See if ExtUtils::Embed and embedding works
lib/ExtUtils/inst Give information about installed extensions
lib/ExtUtils/Install.pm Handles 'make install' on extensions
lib/ExtUtils/Installed.pm Information on installed extensions
-lib/ExtUtils/Installed.t See if ExtUtils::Installed works
lib/ExtUtils/Liblist.pm Locates libraries
lib/ExtUtils/MakeMaker.pm Write Makefiles for extensions
lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
lib/ExtUtils/MANIFEST.SKIP The default MANIFEST.SKIP
-lib/ExtUtils/Manifest.t See if ExtUtils::Manifest works
lib/ExtUtils/Mkbootstrap.pm Writes a bootstrap file (see MakeMaker)
-lib/ExtUtils/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
lib/ExtUtils/Mksymlists.pm Writes a linker options file for extensions
lib/ExtUtils/MM_Cygwin.pm MakeMaker methods for Cygwin
-lib/ExtUtils/MM_Cygwin.t See if ExtUtils::MM_Cygwin works
lib/ExtUtils/MM_NW5.pm MakeMaker methods for NetWare
lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
lib/ExtUtils/MM_Unix.pm MakeMaker base class for Unix
-lib/ExtUtils/MM_Unix.t see if ExtUtils::MM_Unix works
lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS
-lib/ExtUtils/MM_VMS.t See if ExtUtils::MM_VMS works
lib/ExtUtils/MM_Win32.pm MakeMaker methods for Win32
lib/ExtUtils/Packlist.pm Manipulates .packlist files
-lib/ExtUtils/Packlist.t See if Packlist works
+lib/ExtUtils/t/Command.t See if ExtUtils::Command works (Win32 only)
+lib/ExtUtils/t/Embed.t See if ExtUtils::Embed and embedding works
+lib/ExtUtils/t/ExtUtils.t See if extutils work
+lib/ExtUtils/t/Installed.t See if ExtUtils::Installed works
+lib/ExtUtils/t/Manifest.t See if ExtUtils::Manifest works
+lib/ExtUtils/t/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
+lib/ExtUtils/t/MM_Cygwin.t See if ExtUtils::MM_Cygwin works
+lib/ExtUtils/t/MM_UNIX.t See if ExtUtils::MM_UNIX works
+lib/ExtUtils/t/MM_VMS.t See if ExtUtils::MM_VMS works
+lib/ExtUtils/t/Packlist.t See if Packlist works
+lib/ExtUtils/t/testlib.t Fixes up @INC to use just-built extension
lib/ExtUtils/testlib.pm Fixes up @INC to use just-built extension
-lib/ExtUtils/testlib.t Fixes up @INC to use just-built extension
lib/ExtUtils/typemap Extension interface types
lib/ExtUtils/xsubpp External subroutine preprocessor
lib/fastcwd.pl a faster but more dangerous getcwd
==== //depot/perl/lib/ExtUtils/t/Command.t#1 (text) ====
Index: perl/lib/ExtUtils/t/Command.t
--- perl/lib/ExtUtils/t/Command.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/Command.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,161 @@
+#!./perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+BEGIN {
+ 1 while unlink 'ecmdfile';
+ # forcibly remove ecmddir/temp2, but don't import mkpath
+ use File::Path ();
+ File::Path::rmtree( 'ecmddir' );
+}
+
+BEGIN {
+ use Test::More tests => 21;
+ use File::Spec;
+}
+
+{
+ use vars qw( *CORE::GLOBAL::exit );
+
+ # bad neighbor, but test_f() uses exit()
+ *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/;
+ }
+ }
+
+ # this should find the file
+ ($ARGV[0] = $file) =~ s/.\z/\?/;
+ ExtUtils::Command::expand_wildcards();
+
+ is( scalar @ARGV, 1, 'found one file' );
+ like( $ARGV[0], qr/$file/, 'expanded wildcard ? successfully' );
+
+ # try it with the asterisk now
+ ($ARGV[0] = $file) =~ s/.{3}\z/\*/;
+ ExtUtils::Command::expand_wildcards();
+
+ ok( (grep { qr/$file/ } @ARGV), 'expanded wildcard * successfully' );
+
+ # concatenate this file with itself
+ # be extra careful the regex doesn't match itself
+ 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' );
+ is( ! 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]);
+ sleep 2;
+
+ # Just checking modify time stamp, access time stamp is set
+ # to the beginning of the day in Win95.
+ # There's a small chance of a 1 second flutter here.
+ my $stamp = (stat($ARGV[0]))[9];
+ ok( abs($now - $stamp) <= 1, 'checking modify time stamp' ) ||
+ print "# mtime == $stamp, should be $now\n";
+
+ # change a file to read-only
+ @ARGV = ( 0600, 'ecmdfile' );
+ ExtUtils::Command::chmod();
+
+ is( ((stat('ecmdfile'))[2] & 07777) & 0700, 0600, 'change a file to read-only'
+);
+
+ # 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, 'ecmdfile';
+ cp();
+
+ ok( -e File::Spec->join( 'ecmddir', 'temp2', 'ecmdfile' ), 'copied okay' );
+
+ # cp should croak if destination isn't directory (not a great warning)
+ @ARGV = ( 'ecmdfile' ) x 3;
+ eval { cp() };
+
+ like( $@, qr/Too many arguments/, 'cp croaks on error' );
+
+ # move a file to a subdirectory
+ @ARGV = ( 'ecmdfile', 'ecmddir' );
+ mv();
+
+ ok( ! -e 'ecmdfile', 'moved file away' );
+ ok( -e File::Spec->join( 'ecmddir', 'ecmdfile' ), 'file in new location' );
+
+ # mv should also croak with the same wacky warning
+ @ARGV = ( 'ecmdfile' ) x 3;
+
+ eval { mv() };
+ like( $@, qr/Too many arguments/, 'mv croaks on error' );
+
+ # remove some files
+ my @files = @ARGV = ( File::Spec->catfile( 'ecmddir', 'ecmdfile' ),
+ File::Spec->catfile( 'ecmddir', 'temp2', 'ecmdfile' ) );
+ rm_f();
+
+ ok( ! -e $_, "removed $_ successfully" ) for (@ARGV);
+
+ # rm_f dir
+ @ARGV = my $dir = File::Spec->catfile( 'ecmddir' );
+ rm_rf();
+ ok( ! -e $dir, "removed $dir successfully" );
+}
+
+END {
+ 1 while unlink 'ecmdfile';
+ File::Path::rmtree( 'ecmddir' );
+}
+
+package TieOut;
+
+sub TIEHANDLE {
+ bless( \(my $text), $_[0] );
+}
+
+sub PRINT {
+ ${ $_[0] } .= join($/, @_);
+}
==== //depot/perl/lib/ExtUtils/t/Embed.t#1 (text) ====
Index: perl/lib/ExtUtils/t/Embed.t
--- perl/lib/ExtUtils/t/Embed.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/Embed.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,172 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+use Config;
+use ExtUtils::Embed;
+use File::Spec;
+
+open(my $fh,">embed_test.c") || die "Cannot open embed_test.c:$!";
+print $fh <DATA>;
+close($fh);
+
+$| = 1;
+print "1..9\n";
+my $cc = $Config{'cc'};
+my $cl = ($^O eq 'MSWin32' && $cc eq 'cl');
+my $exe = 'embed_test' . $Config{'exe_ext'};
+my $obj = 'embed_test' . $Config{'obj_ext'};
+my $inc = File::Spec->updir;
+my $lib = File::Spec->updir;
+my $libperl_copied;
+my $testlib;
+my @cmd;
+my (@cmd2) if $^O eq 'VMS';
+
+if ($^O eq 'VMS') {
+ push(@cmd,$cc,"/Obj=$obj");
+ my (@incs) = ($inc);
+ my $crazy = ccopts();
+ if ($crazy =~ s#/inc[^=/]*=([\w\$\_\-\.\[\]\:]+)##i) {
+ push(@incs,$1);
+ }
+ if ($crazy =~ s/-I([a-zA-Z0-9\$\_\-\.\[\]\:]*)//) {
+ push(@incs,$1);
+ }
+ $crazy =~ s#/Obj[^=/]*=[\w\$\_\-\.\[\]\:]+##i;
+ push(@cmd,"/Include=(".join(',',@incs).")");
+ push(@cmd,$crazy);
+ push(@cmd,"embed_test.c");
+
+ push(@cmd2,$Config{'ld'}, $Config{'ldflags'}, "/exe=$exe");
+ push(@cmd2,"$obj,[-]perlshr.opt/opt,[-]perlshr_attr.opt/opt");
+
+} else {
+ if ($cl) {
+ push(@cmd,$cc,"-Fe$exe");
+ }
+ else {
+ push(@cmd,$cc,'-o' => $exe);
+ }
+ push(@cmd,"-I$inc",ccopts(),'embed_test.c');
+ if ($^O eq 'MSWin32') {
+ $inc = File::Spec->catdir($inc,'win32');
+ push(@cmd,"-I$inc");
+ $inc = File::Spec->catdir($inc,'include');
+ push(@cmd,"-I$inc");
+ if ($cc eq 'cl') {
+ push(@cmd,'-link',"-libpath:$lib",$Config{'libperl'},$Config{'libc'});
+ }
+ else {
+
+push(@cmd,"-L$lib",File::Spec->catfile($lib,$Config{'libperl'}),$Config{'libc'});
+ }
+ }
+ else {
+ push(@cmd,"-L$lib",'-lperl');
+ }
+ {
+ local $SIG{__WARN__} = sub {
+ warn $_[0] unless $_[0] =~ /No library found for -lperl/
+ };
+ push(@cmd,ldopts());
+ }
+
+ if ($^O eq 'aix') { # AIX needs an explicit symbol export list.
+ my ($perl_exp) = grep { -f } qw(perl.exp ../perl.exp);
+ die "where is perl.exp?\n" unless defined $perl_exp;
+ for (@cmd) {
+ s!-bE:(\S+)!-bE:$perl_exp!;
+ }
+ }
+ elsif ($^O eq 'cygwin') { # Cygwin needs the libperl copied
+ my $v_e_r_s = $Config{version};
+ $v_e_r_s =~ tr/./_/;
+ system("cp ../libperl$v_e_r_s.dll ./"); # for test 1
+ system("cp ../$Config{'libperl'} ../libperl.a"); # for test 1
+ }
+ elsif ($Config{'libperl'} !~ /\Alibperl\./) {
+ # Everyone needs libperl copied if it's not found by '-lperl'.
+ $testlib = $Config{'libperl'};
+ my $srclib = $testlib;
+ $testlib =~ s/^[^.]+/libperl/;
+ $testlib = File::Spec::->catfile($lib, $testlib);
+ $srclib = File::Spec::->catfile($lib, $srclib);
+ if (-f $srclib) {
+ unlink $testlib if -f $testlib;
+ my $lncmd = "$Config{'ln'} $srclib $testlib";
+ #print "# $lncmd\n";
+ $libperl_copied = 1 unless system($lncmd);
+ }
+ }
+}
+my $status;
+my $display_cmd = "@cmd";
+chomp($display_cmd); # where is the newline coming from? ldopts()?
+print "# $display_cmd\n";
+$status = system(join(' ',@cmd));
+if ($^O eq 'VMS' && !$status) {
+ print "# @cmd2\n";
+ $status = system(join(' ',@cmd2));
+}
+print (($status? 'not ': '')."ok 1\n");
+
+my $embed_test = File::Spec->catfile(File::Spec->curdir, $exe);
+$embed_test = "run/nodebug $exe" if $^O eq 'VMS';
+print "# embed_test = $embed_test\n";
+$status = system($embed_test);
+print (($status? 'not ':'')."ok 9 # $status\n");
+unlink($exe,"embed_test.c",$obj);
+unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS';
+unlink(glob("./libperl*.dll")) if $^O eq 'cygwin';
+unlink("../libperl.a") if $^O eq 'cygwin';
+unlink($testlib) if $libperl_copied;
+
+# gcc -g -I.. -L../ -o perl_test perl_test.c -lperl `../perl -I../lib
+-MExtUtils::Embed -I../ -e ccopts -e ldopts`
+
+__END__
+
+/* perl_test.c */
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#define my_puts(a) if(puts(a) < 0) exit(666)
+
+char *cmds[] = { "perl","-e", "print qq[ok 5\\n]", NULL };
+
+int main(int argc, char **argv, char **env)
+{
+ PerlInterpreter *my_perl = perl_alloc();
+
+ my_puts("ok 2");
+
+ perl_construct(my_perl);
+
+ my_puts("ok 3");
+
+ perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, cmds, env);
+
+ my_puts("ok 4");
+
+ fflush(stdout);
+
+ perl_run(my_perl);
+
+ my_puts("ok 6");
+
+ perl_destruct(my_perl);
+
+ my_puts("ok 7");
+
+ perl_free(my_perl);
+
+ my_puts("ok 8");
+
+ return 0;
+}
+
+
+
+
==== //depot/perl/lib/ExtUtils/t/ExtUtils.t#1 (text) ====
Index: perl/lib/ExtUtils/t/ExtUtils.t
--- perl/lib/ExtUtils/t/ExtUtils.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/ExtUtils.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,501 @@
+#!./perl -w
+
+print "1..27\n";
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+# 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);
+# 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
+# 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;
+
+print "# perl=$perl\n";
+my $runperl = "$perl -x \"-I../../lib\"";
+
+$| = 1;
+
+my $dir = "ext-$$";
+my @files;
+
+print "# $dir being created...\n";
+mkdir $dir, 0777 or die "mkdir: $!\n";
+
+my $output = "output";
+
+END {
+ use File::Path;
+ print "# $dir being removed...\n";
+ rmtree($dir);
+}
+
+my $package = "ExtTest";
+
+# 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 $parent_rfc1149 =
+ 'A Standard for the Transmission of IP Datagrams on Avian Carriers';
+
+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;"},
+);
+
+push @names, $_ foreach keys %compass;
+
+my @names_only = map {(ref $_) ? $_->{name} : $_} @names;
+
+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
+
+EOT
+
+while (my ($point, $bearing) = each %compass) {
+ print FH "#define $point $bearing\n"
+}
+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";
+
+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";
+
+################ 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";
+
+print FH <<'EOT';
+
+use strict;
+EOT
+printf FH "use warnings;\n" unless $] < 5.006;
+print FH <<'EOT';
+use Carp;
+
+require Exporter;
+require DynaLoader;
+use vars qw ($VERSION @ISA @EXPORT_OK $AUTOLOAD);
+
+$VERSION = '0.01';
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(
+EOT
+
+print FH "\t$_\n" foreach (@names_only);
+print FH ");\n";
+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";
+
+print "1..1\n";
+if (open OUTPUT, ">$output") {
+ print "ok 1\n";
+ select OUTPUT;
+} else {
+ print "not ok 1 # Failed to open '$output': $!\n";
+ exit 1;
+}
+EOT
+
+print FH << 'EOT';
+
+# What follows goes to the temporary file.
+# IV
+my $five = FIVE;
+if ($five == 5) {
+ print "ok 5\n";
+} else {
+ print "not ok 5 # $five\n";
+}
+
+# PV
+print OK6;
+
+# PVN containing embedded \0s
+$_ = OK7;
+s/.*\0//s;
+print;
+
+# NV
+my $farthing = FARTHING;
+if ($farthing == 0.25) {
+ print "ok 8\n";
+} else {
+ print "not ok 8 # $farthing\n";
+}
+
+# UV
+my $not_zero = NOT_ZERO;
+if ($not_zero > 0 && $not_zero == ~0) {
+ print "ok 9\n";
+} else {
+ print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
+}
+
+# Value includes a "*/" in an attempt to bust out of a C comment.
+# Also tests custom cpp #if clauses
+my $close = CLOSE;
+if ($close eq '*/') {
+ print "ok 10\n";
+} else {
+ print "not ok 10 # \$close='$close'\n";
+}
+
+# Default values if macro not defined.
+my $answer = ANSWER;
+if ($answer == 42) {
+ print "ok 11\n";
+} else {
+ print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
+}
+
+# not defined macro
+my $notdef = eval { NOTDEF; };
+if (defined $notdef) {
+ print "not ok 12 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
+ print "not ok 12 # \$@='$@'\n";
+} else {
+ print "ok 12\n";
+}
+
+# not a macro
+my $notthere = eval { &ExtTest::NOTTHERE; };
+if (defined $notthere) {
+ print "not ok 13 # \$notthere='$notthere'\n";
+} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
+ chomp $@;
+ print "not ok 13 # \$@='$@'\n";
+} else {
+ print "ok 13\n";
+}
+
+# Truth
+my $yes = Yes;
+if ($yes) {
+ print "ok 14\n";
+} else {
+ print "not ok 14 # $yes='\$yes'\n";
+}
+
+# Falsehood
+my $no = No;
+if (defined $no and !$no) {
+ print "ok 15\n";
+} else {
+ print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
+}
+
+# Undef
+my $undef = Undef;
+unless (defined $undef) {
+ print "ok 16\n";
+} else {
+ print "not ok 16 # \$undef='$undef'\n";
+}
+
+
+# invalid macro (chosen to look like a mix up between No and SW)
+$notdef = eval { &ExtTest::So };
+if (defined $notdef) {
+ print "not ok 17 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /^So is not a valid ExtTest macro/) {
+ print "not ok 17 # \$@='$@'\n";
+} else {
+ print "ok 17\n";
+}
+
+# invalid defined macro
+$notdef = eval { &ExtTest::EW };
+if (defined $notdef) {
+ print "not ok 18 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /^EW is not a valid ExtTest macro/) {
+ print "not ok 18 # \$@='$@'\n";
+} else {
+ print "ok 18\n";
+}
+
+my %compass = (
+EOT
+
+while (my ($point, $bearing) = each %compass) {
+ print FH "'$point' => $bearing, "
+}
+
+print FH <<'EOT';
+
+);
+
+my $fail;
+while (my ($point, $bearing) = each %compass) {
+ my $val = eval $point;
+ if ($@) {
+ print "# $point: \$@='$@'\n";
+ $fail = 1;
+ } elsif (!defined $bearing) {
+ print "# $point: \$val=undef\n";
+ $fail = 1;
+ } elsif ($val != $bearing) {
+ print "# $point: \$val=$val, not $bearing\n";
+ $fail = 1;
+ }
+}
+if ($fail) {
+ print "not ok 19\n";
+} else {
+ print "ok 19\n";
+}
+
+EOT
+
+print FH <<"EOT";
+my \$rfc1149 = RFC1149;
+if (\$rfc1149 ne "$parent_rfc1149") {
+ print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
+} else {
+ print "ok 20\n";
+}
+
+if (\$rfc1149 != 1149) {
+ printf "not ok 21 # %d != 1149\n", \$rfc1149;
+} else {
+ print "ok 21\n";
+}
+
+EOT
+
+print FH <<'EOT';
+# test macro=>1
+my $open = OPEN;
+if ($open eq '/*') {
+ print "ok 22\n";
+} else {
+ print "not ok 22 # \$open='$open'\n";
+}
+EOT
+close FH or die "close $testpl: $!\n";
+
+################ 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";
+
+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";
+}
+my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old');
+push @files, "$makefile$makefile_rename"; # Renamed by make clean
+
+my $make = $Config{make};
+
+$make = $ENV{MAKE} if exists $ENV{MAKE};
+
+if ($^O eq 'MSWin32' && $make eq 'nmake') { $make .= " -nologo"; }
+
+my @makeout;
+
+print "# make = '$make'\n";
+@makeout = `$make`;
+if ($?) {
+ print "not ok 3 # $make failed: $?\n";
+ print "# $_" foreach @makeout;
+ exit($?);
+} else {
+ print "ok 3\n";
+}
+
+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($?);
+ } else {
+ print "ok 4\n";
+ }
+}
+
+push @files, $output;
+
+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";
+}
+
+my $test = 23;
+
+if ($?) {
+ print "not ok $test # $maketest failed: $?\n";
+ print "# $_" foreach @makeout;
+} else {
+ print "ok $test\n";
+}
+$test++;
+
+my $regen = `$runperl $package.xs`;
+if ($?) {
+ print "not ok $test # $runperl $package.xs failed: $?\n";
+} else {
+ print "ok $test\n";
+}
+$test++;
+
+my $expect = $constant_types . $C_constant .
+ "\n#### XS Section:\n" . $XS_constant;
+
+if ($expect eq $regen) {
+ print "ok $test\n";
+} else {
+ print "not ok $test\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++;
+
+foreach (@files) {
+ unlink $_ or warn "unlink $_: $!";
+}
+
+my $fail;
+opendir DIR, "." or die "opendir '.': $!";
+while (defined (my $entry = readdir DIR)) {
+ next if $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";
+}
==== //depot/perl/lib/ExtUtils/t/Installed.t#1 (text) ====
Index: perl/lib/ExtUtils/t/Installed.t
--- perl/lib/ExtUtils/t/Installed.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/Installed.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,204 @@
+#!./perl
+
+use strict;
+use warnings;
+
+# for _is_type() tests
+use Config;
+
+# for new() tests
+use Cwd;
+use File::Path;
+
+# for directories() tests
+use File::Basename;
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 43;
+
+use_ok( 'ExtUtils::Installed' );
+
+# saves having to qualify package name for class methods
+my $ei = bless( {}, 'ExtUtils::Installed' );
+
+# _is_prefix
+is( $ei->_is_prefix('foo/bar', 'foo'), 1,
+ '_is_prefix() should match valid path prefix' );
+is( $ei->_is_prefix('\foo\bar', '\bar'), 0,
+ '... should not match wrong prefix' );
+
+# _is_type
+is( $ei->_is_type(0, 'all'), 1, '_is_type() should be true for type of "all"' );
+
+foreach my $path (qw( installman1dir installman3dir )) {
+ my $file = $Config{$path} . '/foo';
+ is( $ei->_is_type($file, 'doc'), 1, "... should find doc file in $path" );
+ is( $ei->_is_type($file, 'prog'), 0, "... but not prog file in $path" );
+}
+
+is( $ei->_is_type($Config{prefix} . '/bar', 'prog'), 1,
+ "... should find prog file under $Config{prefix}" );
+is( $ei->_is_type('bar', 'doc'), 0,
+ '... should not find doc file outside path' );
+is( $ei->_is_type('bar', 'prog'), 0,
+ '... nor prog file outside path' );
+is( $ei->_is_type('whocares', 'someother'), 0, '... nor other type anywhere' );
+
+# _is_under
+ok( $ei->_is_under('foo'), '_is_under() should return true with no dirs' );
+
+my @under = qw( boo bar baz );
+is( $ei->_is_under('foo', @under), 0, '... should find no file not under dirs');
+is( $ei->_is_under('baz', @under), 1, '... should find file under dir' );
+
+# new
+my $realei = ExtUtils::Installed->new();
+
+isa_ok( $realei, 'ExtUtils::Installed' );
+isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
+is( $realei->{Perl}{version}, $Config{version},
+ 'new() should set Perl version from %Config' );
+
+my $wrotelist;
+if (mkpath('auto/FakeMod')) {
+ if (open(PACKLIST, '>', 'auto/FakeMod/.packlist')) {
+ print PACKLIST 'list';
+ close PACKLIST;
+ if (open(FAKEMOD, '>', 'auto/FakeMod/FakeMod.pm')) {
+ print FAKEMOD <<'FAKE';
+package FakeMod;
+use vars qw( $VERSION );
+$VERSION = '1.1.1';
+1;
+FAKE
+
+ close FAKEMOD;
+ $wrotelist = 1;
+ }
+ }
+}
+
+
+SKIP: {
+ skip( "could not write packlist: $!", 3 ) unless $wrotelist;
+
+ # avoid warning and death by localizing glob
+ local *ExtUtils::Installed::Config;
+ %ExtUtils::Installed::Config = (
+ archlib => cwd(),
+ sitearch => cwd() . 'auto/FakeMod',
+ );
+
+ # necessary to fool new()
+ push @INC, cwd() . '/auto/FakeMod';
+
+ my $realei = ExtUtils::Installed->new();
+ ok( exists $realei->{FakeMod}, 'new() should find modules with .packlists');
+ isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
+ is( $realei->{FakeMod}{version}, '1.1.1',
+ '... should find version in modules' );
+}
+
+# modules
+$ei->{$_} = 1 for qw( abc def ghi );
+is( join(' ', $ei->modules()), 'abc def ghi',
+ 'modules() should return sorted keys' );
+
+# files
+$ei->{goodmod} = {
+ packlist => {
+ $Config{installman1dir} . '/foo' => 1,
+ $Config{installman3dir} . '/bar' => 1,
+ $Config{prefix} . '/foobar' => 1,
+ foobaz => 1,
+ },
+};
+
+eval { $ei->files('badmod') };
+like( $@, qr/badmod is not installed/,'files() should croak given bad modname');
+eval { $ei->files('goodmod', 'badtype' ) };
+like( $@, qr/type must be/,'files() should croak given bad type' );
+my @files = $ei->files('goodmod', 'doc', $Config{installman1dir});
+is( scalar @files, 1, '... should find doc file under given dir' );
+like( $files[0], qr/foo$/, '... checking file name' );
+@files = $ei->files('goodmod', 'doc');
+is( scalar @files, 2, '... should find all doc files with no dir' );
+@files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
+is( scalar @files, 0, '... should find no doc files given wrong dirs' );
+@files = $ei->files('goodmod', 'prog');
+is( scalar @files, 1, '... should find doc file in correct dir' );
+like( $files[0], qr/foobar$/, '... checking file name' );
+@files = $ei->files('goodmod');
+is( scalar @files, 4, '... should find all files with no type specified' );
+my %dirnames = map { $_ => dirname($_) } @files;
+
+# directories
+my @dirs = $ei->directories('goodmod', 'prog', 'fake');
+is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );
+@dirs = $ei->directories('goodmod', 'doc');
+is( scalar @dirs, 2, '... should find all files files() would' );
+@dirs = $ei->directories('goodmod');
+is( scalar @dirs, 4, '... should find all files files() would, again' );
+@files = sort map { exists $dirnames{$_} ? $dirnames{$_} : '' } @files;
+is( join(' ', @files), join(' ', @dirs), '... should sort output' );
+
+# directory_tree
+my $expectdirs =
+ dirname($Config{installman1dir}) eq dirname($Config{installman3dir}) ? 3 :2;
+
+@dirs = $ei->directory_tree('goodmod', 'doc', dirname($Config{installman1dir}));
+is( scalar @dirs, $expectdirs,
+ 'directory_tree() should report intermediate dirs to those requested' );
+
+my $fakepak = Fakepak->new(102);
+
+$ei->{yesmod} = {
+ version => 101,
+ packlist => $fakepak,
+};
+
+# these should all croak
+foreach my $sub (qw( validate packlist version )) {
+ eval { $ei->$sub('nomod') };
+ like( $@, qr/nomod is not installed/,
+ "$sub() should croak when asked about uninstalled module" );
+}
+
+# validate
+is( $ei->validate('yesmod'), 'validated',
+ 'validate() should return results of packlist validate() call' );
+
+# packlist
+is( ${ $ei->packlist('yesmod') }, 102,
+ 'packlist() should report installed mod packlist' );
+
+# version
+is( $ei->version('yesmod'), 101,
+ 'version() should report installed mod version' );
+
+# needs a DESTROY, for some reason
+can_ok( $ei, 'DESTROY' );
+
+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;
+
+sub new {
+ my $class = shift;
+ bless(\(my $scalar = shift), $class);
+}
+
+sub validate {
+ 'validated'
+}
==== //depot/perl/lib/ExtUtils/t/MM_Cygwin.t#1 (text) ====
Index: perl/lib/ExtUtils/t/MM_Cygwin.t
--- perl/lib/ExtUtils/t/MM_Cygwin.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/MM_Cygwin.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,105 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More;
+
+BEGIN {
+ if ($^O =~ /cygwin/i) {
+ plan tests => 17;
+ } else {
+ plan skip_all => "This is not cygwin";
+ }
+}
+
+use Config;
+use File::Spec;
+
+# MM package faked up by messy MI entanglement
+@MM::ISA = qw( ExtUtils::MM_Unix ExtUtils::Liblist::Kid ExtUtils::MakeMaker );
+
+use_ok( 'ExtUtils::MM_Cygwin' );
+
+# test canonpath
+my $path = File::Spec->canonpath('/a/../../c');
+is( MM->canonpath('/a/../../c'), $path,
+ 'canonpath() method should work just like the one in File::Spec' );
+
+# test cflags, with the fake package below
+my $args = bless({
+ CFLAGS => 'fakeflags',
+ CCFLAGS => '',
+}, MM);
+
+# with CFLAGS set, it should be returned
+is( $args->cflags(), 'fakeflags',
+ 'cflags() should return CFLAGS member data, if set' );
+
+delete $args->{CFLAGS};
+
+# ExtUtils::MM_Cygwin::cflags() calls this, fake the output
+*ExtUtils::MM_Unix::cflags = sub { return $_[1] };
+
+# respects the config setting, should ignore whitespace around equal sign
+my $ccflags = $Config{useshrplib} eq 'true' ? ' -DUSEIMPORTLIB' : '';
+$args->cflags(<<FLAGS);
+OPTIMIZE = opt
+PERLTYPE =pt
+LARGE= lg
+SPLIT=split
+FLAGS
+
+like( $args->{CFLAGS}, qr/OPTIMIZE = opt/, '... should set OPTIMIZE' );
+like( $args->{CFLAGS}, qr/PERLTYPE = pt/, '... should set PERLTYPE' );
+like( $args->{CFLAGS}, qr/LARGE = lg/, '... should set LARGE' );
+like( $args->{CFLAGS}, qr/SPLIT = split/, '... should set SPLIT' );
+like( $args->{CFLAGS}, qr/CCFLAGS = $ccflags/, '... should set CCFLAGS' );
+
+# test manifypods
+$args = bless({
+ NOECHO => 'noecho',
+ MAN3PODS => {},
+ MAN1PODS => {},
+}, 'MM');
+like( $args->manifypods(), qr/pure_all\n\tnoecho/,
+ 'manifypods() should return without PODS values set' );
+
+$args->{MAN3PODS} = { foo => 1 };
+my $out = tie *STDOUT, 'FakeOut';
+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' );
+
+$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');
+
+# test perl_archive
+my $libperl = $Config{libperl} || 'libperl.a';
+is( $args->perl_archive(), "\$(PERL_INC)/$libperl",
+ 'perl_archive() should respect libperl setting' );
+
+# test import of $Verbose and &neatvalue
+can_ok( 'ExtUtils::MM_Cygwin', 'neatvalue' );
+is( $ExtUtils::MM_Cygwin::Verbose, $ExtUtils::MakeMaker::Verbose,
+ 'ExtUtils::MM_Cygwin should import $Verbose from ExtUtils::MakeMaker' );
+
+package FakeOut;
+
+sub TIEHANDLE {
+ bless(\(my $scalar), $_[0]);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= shift;
+}
==== //depot/perl/lib/ExtUtils/t/MM_Unix.t#1 (text) ====
Index: perl/lib/ExtUtils/t/MM_Unix.t
--- perl/lib/ExtUtils/t/MM_Unix.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/MM_Unix.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,132 @@
+#!./perl -w
+
+# 2001-12-16 Tels first version
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+BEGIN { use Test::More; plan tests => 90; }
+
+BEGIN { use_ok( 'ExtUtils::MM_Unix' ); }
+
+use strict;
+use File::Spec;
+
+my $class = 'ExtUtils::MM_Unix';
+
+# only one of the following can be true
+# test should be removed if MM_Unix ever stops handling other OS than Unix
+my $os = ($ExtUtils::MM_Unix::Is_OS2 || 0)
+ + ($ExtUtils::MM_Unix::Is_Mac || 0)
+ + ($ExtUtils::MM_Unix::Is_Win32 || 0)
+ + ($ExtUtils::MM_Unix::Is_Dos || 0)
+ + ($ExtUtils::MM_Unix::Is_VMS || 0);
+ok ( $os <= 1, 'There can be only one (or none)');
+
+is ($ExtUtils::MM_Unix::VERSION, '1.12604', 'Should be that version');
+
+# when the following calls like canonpath, catdir etc are replaced by
+# File::Spec calls, the test's become a bit pointless
+
+foreach ( qw( xx/ ./xx/ xx/././xx xx///xx) )
+ {
+ is ($class->canonpath($_), File::Spec->canonpath($_), "canonpath $_");
+ }
+
+is ($class->catdir('xx','xx'), File::Spec->catdir('xx','xx'),
+ 'catdir(xx, xx) => xx/xx');
+is ($class->catfile('xx','xx','yy'), File::Spec->catfile('xx','xx','yy'),
+ 'catfile(xx, xx) => xx/xx');
+
+foreach (qw/updir curdir rootdir/)
+ {
+ is ($class->$_(), File::Spec->$_(), $_ );
+ }
+
+foreach ( qw /
+ c_o
+ clean
+ const_cccmd
+ const_config
+ const_loadlibs
+ constants
+ depend
+ dir_target
+ dist
+ dist_basics
+ dist_ci
+ dist_core
+ dist_dir
+ dist_test
+ dlsyms
+ dynamic
+ dynamic_bs
+ dynamic_lib
+ exescan
+ export_list
+ extliblist
+ file_name_is_absolute
+ find_perl
+ fixin
+ force
+ guess_name
+ has_link_code
+ htmlifypods
+ init_dirscan
+ init_main
+ init_others
+ install
+ installbin
+ libscan
+ linkext
+ lsdir
+ macro
+ makeaperl
+ makefile
+ manifypods
+ maybe_command
+ maybe_command_in_dirs
+ needs_linking
+ nicetext
+ parse_version
+ pasthru
+ path
+ perl_archive
+ perl_archive_after
+ perl_script
+ perldepend
+ pm_to_blib
+ post_constants
+ post_initialize
+ postamble
+ ppd
+ prefixify
+ processPL
+ quote_paren
+ realclean
+ replace_manpage_separator
+ static
+ static_lib
+ staticmake
+ subdir_x
+ subdirs
+ test
+ test_via_harness
+ test_via_script
+ tool_autosplit
+ tool_xsubpp
+ tools_other
+ top_targets
+ writedoc
+ xs_c
+ xs_cpp
+ xs_o
+ xsubpp_version
+ / )
+ {
+ ok ($class->can ($_), "can $_");
+ }
+
+
==== //depot/perl/lib/ExtUtils/t/MM_VMS.t#1 (text) ====
Index: perl/lib/ExtUtils/t/MM_VMS.t
--- perl/lib/ExtUtils/t/MM_VMS.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/MM_VMS.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,80 @@
+#!./perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+BEGIN {
+ use Test::More;
+ if ($^O eq 'VMS') {
+ plan( tests => 13 ); # 49 or more some day...
+ }
+ # MM_VMS does a C<use VMS::Filespec;> but that module
+ # is unlikely to be installed on non VMS machines
+ # (although not impossible: no xs, no sys$parse(), pure perl).
+ else {
+ plan( skip_all => "This is not VMS" );
+ }
+}
+
+BEGIN {
+ use_ok( 'ExtUtils::MM_VMS' );
+}
+
+# Those methods that can be ascertained to be defined(), albeit with
+# no passed arguments, are so "tested". Unfortunately, we omit
+# testing of methods that need non-trivial arguments.
+# Thus leaving test coverage at far less than 100% (patches welcome).
+# The lines '#' commented out below are tests that failed with
+# the empty arguments.
+
+ok(defined(ExtUtils::MM_VMS::wraplist()),'wraplist defined');
+ok(defined(ExtUtils::MM_VMS::rootdir()),'rootdir defined');
+ok(!defined(ExtUtils::MM_VMS::ext()),'ext() not defined');
+ok(defined(ExtUtils::MM_VMS::guess_name()),'guess_name defined');
+#ok(!defined(ExtUtils::MM_VMS::find_perl()),' defined');
+ok(defined(ExtUtils::MM_VMS::path()),'path defined');
+#ok(defined(ExtUtils::MM_VMS::maybe_command()),' defined');
+#ok(defined(ExtUtils::MM_VMS::maybe_command_in_dirs()),' defined');
+#ok(defined(ExtUtils::MM_VMS::perl_script()),'perl_script defined');
+#ok(defined(ExtUtils::MM_VMS::file_name_is_absolute()),'file_name_is_absolute
+defined');
+#ok(defined(ExtUtils::MM_VMS::replace_manpage_separator()),'replace_manpage_separator
+defined');
+#ok(defined(ExtUtils::MM_VMS::init_others()),'init_others defined');
+#ok(defined(ExtUtils::MM_VMS::constants()),'constants defined');
+#ok(defined(ExtUtils::MM_VMS::cflags()),'cflags defined');
+#ok(defined(ExtUtils::MM_VMS::const_cccmd()),'const_cccmd defined');
+#ok(defined(ExtUtils::MM_VMS::pm_to_blib()),'pm_to_blib defined');
+ok(defined(ExtUtils::MM_VMS::tool_autosplit()),'tool_autosplit defined');
+#ok(defined(ExtUtils::MM_VMS::tool_xsubpp()),'tool_xsubpp defined');
+#ok(defined(ExtUtils::MM_VMS::xsubpp_version()),'xsubpp_version defined');
+#ok(defined(ExtUtils::MM_VMS::tools_other()),'tools_other defined');
+#ok(defined(ExtUtils::MM_VMS::dist()),'dist defined');
+#ok(defined(ExtUtils::MM_VMS::c_o()),'c_o defined');
+#ok(defined(ExtUtils::MM_VMS::xs_c()),'xs_c defined');
+#ok(defined(ExtUtils::MM_VMS::xs_o()),'xs_o defined');
+#ok(defined(ExtUtils::MM_VMS::top_targets()),'top_targets defined');
+#ok(defined(ExtUtils::MM_VMS::dlsyms()),'dlsyms defined');
+#ok(defined(ExtUtils::MM_VMS::dynamic_lib()),'dynamic_lib defined');
+#ok(defined(ExtUtils::MM_VMS::dynamic_bs()),'dynamic_bs defined');
+#ok(defined(ExtUtils::MM_VMS::static_lib()),'static_lib defined');
+#ok(defined(ExtUtils::MM_VMS::manifypods({})),'manifypods defined');
+#ok(defined(ExtUtils::MM_VMS::processPL()),'processPL defined');
+ok(defined(ExtUtils::MM_VMS::installbin()),'installbin defined');
+#ok(defined(ExtUtils::MM_VMS::subdir_x()),'subdir_x defined');
+#ok(defined(ExtUtils::MM_VMS::clean()),'clean defined');
+#ok(defined(ExtUtils::MM_VMS::realclean()),'realclean defined');
+ok(defined(ExtUtils::MM_VMS::dist_basics()),'dist_basics defined');
+ok(defined(ExtUtils::MM_VMS::dist_core()),'dist_core defined');
+ok(defined(ExtUtils::MM_VMS::dist_dir()),'dist_dir defined');
+ok(defined(ExtUtils::MM_VMS::dist_test()),'dist_test defined');
+#ok(defined(ExtUtils::MM_VMS::install()),'install defined');
+#ok(defined(ExtUtils::MM_VMS::perldepend()),'perldepend defined');
+ok(defined(ExtUtils::MM_VMS::makefile()),'makefile defined');
+#ok(defined(ExtUtils::MM_VMS::test()),'test defined');
+#ok(defined(ExtUtils::MM_VMS::test_via_harness()),'test_via_harness defined');
+#ok(defined(ExtUtils::MM_VMS::test_via_script()),'test_via_script defined');
+#ok(defined(ExtUtils::MM_VMS::makeaperl()),'makeaperl defined');
+#ok(!defined(ExtUtils::MM_VMS::nicetext()),'nicetext() not defined');
+
+
==== //depot/perl/lib/ExtUtils/t/Manifest.t#1 (text) ====
Index: perl/lib/ExtUtils/t/Manifest.t
--- perl/lib/ExtUtils/t/Manifest.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/Manifest.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,157 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
+# these files help the test run
+use Test::More tests => 31;
+use Cwd;
+
+# these files are needed for the module itself
+use File::Spec;
+use File::Path;
+use Carp::Heavy;
+
+# keep track of everything added so it can all be deleted
+my @files;
+sub add_file {
+ my ($file, $data) = @_;
+ $data ||= 'foo';
+ open( my $T, '>', $file) or return;
+ print $T $data;
+ push @files, $file;
+}
+
+sub read_manifest {
+ open( my $M, 'MANIFEST' ) or return;
+ chomp( my @files = <$M> );
+ return @files;
+}
+
+sub catch_warning {
+ my $warn;
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ return join('', $_[0]->() ), $warn;
+}
+
+sub remove_dir {
+ ok( rmdir( $_ ), "remove $_ directory" ) for @_;
+}
+
+# use module, import functions
+use_ok( 'ExtUtils::Manifest',
+ qw( mkmanifest manicheck filecheck fullcheck maniread manicopy) );
+
+my $cwd = Cwd::getcwd();
+
+# Just in case any old files were lying around.
+rmtree('mantest');
+
+ok( mkdir( 'mantest', 0777 ), 'make mantest directory' );
+ok( chdir( 'mantest' ), 'chdir() to mantest' );
+ok( add_file('foo'), 'add a temporary file' );
+
+# there shouldn't be a MANIFEST there
+my ($res, $warn) = catch_warning( \&mkmanifest );
+# Canonize the order.
+$warn = join("", map { "$_|" } sort { lc $a cmp lc $b } split /\r?\n/, $warn);
+is( $warn, "Added to MANIFEST: foo|Added to MANIFEST: MANIFEST|",
+ "mkmanifest() displayed it's additions" );
+
+# and now you see it
+ok( -e 'MANIFEST', 'create MANIFEST file' );
+
+my @list = read_manifest();
+is( @list, 2, 'check files in MANIFEST' );
+ok( ! ExtUtils::Manifest::filecheck(), 'no additional files in directory' );
+
+# after adding bar, the MANIFEST is out of date
+ok( add_file( 'bar' ), 'add another file' );
+ok( ! manicheck(), 'MANIFEST now out of sync' );
+
+# it reports that bar has been added and throws a warning
+($res, $warn) = catch_warning( \&filecheck );
+
+like( $warn, qr/^Not in MANIFEST: bar/, 'warning that bar has been added' );
+is( $res, 'bar', 'bar reported as new' );
+
+# now quiet the warning that bar was added and test again
+use vars qw($ExtUtils::Manifest::Quiet);
+$ExtUtils::Manifest::Quiet = 1;
+($res, $warn) = catch_warning( \&ExtUtils::Manifest::skipcheck );
+is( $warn, '', 'disabled warnings' );
+
+# add a skip file with a rule to skip itself
+add_file( 'MANIFEST.SKIP', "baz\n.SKIP" );
+
+# this'll skip the new file
+($res, $warn) = catch_warning( \&ExtUtils::Manifest::skipcheck );
+like( $warn, qr/^Skipping MANIFEST\.SKIP/, 'got skipping warning' );
+
+# I'm not sure why this should be... shouldn't $missing be the only one?
+my ($found, $missing );
+catch_warning( sub {
+ ( $found, $missing ) = ExtUtils::Manifest::skipcheck()
+});
+
+# nothing new should be found, bar should be skipped
+is( @$found, 0, 'no output here' );
+is( join( ' ', @$missing ), 'bar', 'listed skipped files' );
+
+is( join(' ', filecheck() ), 'bar', 'listing skipped with filecheck()' );
+
+# add a subdirectory and a file there that should be found
+ok( mkdir( 'moretest', 0777 ), 'created moretest directory' );
+my $quux = File::Spec->catfile( 'moretest', 'quux' );
+$quux =~ s#\\#/#g;
+$quux = VMS::Filespec::unixify($quux) if $^O eq 'VMS';
+add_file( $quux, 'quux' );
+ok( exists( ExtUtils::Manifest::manifind()->{$quux} ), "manifind found $quux" );
+
+# only MANIFEST and foo are in the manifest
+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' );
+
+# poison the manifest, and add a comment that should be reported
+add_file( 'MANIFEST', 'none #none' );
+is( ExtUtils::Manifest::maniread()->{none}, '#none', 'maniread found comment' );
+
+ok( mkdir( 'copy', 0777 ), 'made copy directory' );
+
+$files = maniread();
+eval { (undef, $warn) = catch_warning( sub {
+ manicopy( $files, 'copy', 'cp' ) })
+};
+
+# a newline comes through, so get rid of it
+chomp($warn);
+
+# the copy should have given one warning and one error
+is($warn, 'Skipping MANIFEST.SKIP', 'warned about MANIFEST.SKIP' );
+like( $@, qr/^Can't read none: /,
+ 'carped about none' );
+
+# tell ExtUtils::Manifest to use a different file
+use vars qw($ExtUtils::Manifest::MANIFEST);
+$ExtUtils::Manifest::MANIFEST = 'albatross';
+
+($res, $warn) = catch_warning( \&mkmanifest );
+like( $warn, qr/Added to albatross: /, 'using a new manifest file' );
+
+# add the new file to the list of files to be deleted
+push @files, 'albatross';
+
+END {
+ # the arrays are evaluated in scalar context
+ is( unlink( @files ), @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' );
+}
+
==== //depot/perl/lib/ExtUtils/t/Mkbootstrap.t#1 (text) ====
Index: perl/lib/ExtUtils/t/Mkbootstrap.t
--- perl/lib/ExtUtils/t/Mkbootstrap.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/Mkbootstrap.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,165 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use vars qw( $required );
+use Test::More tests => 18;
+
+use_ok( 'ExtUtils::Mkbootstrap' );
+
+
+# Mkbootstrap makes a backup copy of "$_[0].bs" if it exists and is non-zero
+my $file_is_ready;
+local *OUT;
+if (open(OUT, '>mkboot.bs')) {
+ $file_is_ready = 1;
+ print OUT 'meaningless text';
+ close OUT;
+}
+
+SKIP: {
+ skip("could not make dummy .bs file: $!", 2) unless $file_is_ready;
+
+ Mkbootstrap('mkboot');
+ ok( -s 'mkboot.bso', 'Mkbootstrap should backup the .bs file' );
+ local *IN;
+ if (open(IN, 'mkboot.bso')) {
+ chomp ($file_is_ready = <IN>);
+ close IN;
+ }
+
+ is( $file_is_ready, 'meaningless text', 'backup should be a perfect copy' );
+}
+
+
+# if it doesn't exist or is zero bytes in size, it won't be backed up
+Mkbootstrap('fakeboot');
+ok( !( -f 'fakeboot.bso' ), 'Mkbootstrap should not backup an empty file' );
+
+
+my $out = tie *STDOUT, 'TieOut';
+
+# with $Verbose set, it should print status messages about libraries
+$ExtUtils::Mkbootstrap::Verbose = 1;
+Mkbootstrap();
+is( $out->read, "\tbsloadlibs=\n", 'should report libraries in Verbose mode' );
+
+Mkbootstrap('', 'foo');
+like( $out->read, qr/bsloadlibs=foo/, 'should still report libraries' );
+
+
+# if ${_[0]}_BS exists, require it
+$file_is_ready = open(OUT, '>boot_BS');
+
+SKIP: {
+ skip("cannot open boot_BS for writing: $!", 1) unless $file_is_ready;
+
+ print OUT '$main::required = 1';
+ close OUT;
+ Mkbootstrap('boot');
+
+ ok( $required, 'baseext_BS file should be require()d' );
+}
+
+
+# if there are any arguments, open a file named baseext.bs
+$file_is_ready = open(OUT, '>dasboot.bs');
+
+SKIP: {
+ skip("cannot make dasboot.bs: $!", 5) unless $file_is_ready;
+
+ # if it can't be opened for writing, we want to prove that it'll die
+ close OUT;
+ chmod 0444, 'dasboot.bs';
+
+ SKIP: {
+ skip("can write readonly files", 1) if -w 'dasboot.bs';
+
+ eval{ Mkbootstrap('dasboot', 1) };
+ like( $@, qr/Unable to open dasboot\.bs/, 'should die given bad filename'
+);
+ }
+
+ # now put it back like it was
+ chmod 0777, 'dasboot.bs';
+ eval{ Mkbootstrap('dasboot', 'myarg') };
+ is( $@, '', 'should not die, given good filename' );
+
+ # red and reed (a visual pun makes tests worth reading)
+ my $read = $out->read();
+ like( $read, qr/Writing dasboot.bs/, 'should print status' );
+ like( $read, qr/containing: my/, 'should print verbose status on request' );
+
+ # now be tricky, and set the status for the next skip block
+ $file_is_ready = open(IN, 'dasboot.bs');
+ ok( $file_is_ready, 'should have written a new .bs file' );
+}
+
+
+SKIP: {
+ skip("cannot read .bs file: $!", 2) unless $file_is_ready;
+
+ my $file = do { local $/ = <IN> };
+
+ # filename should be in header
+ like( $file, qr/# dasboot DynaLoader/, 'file should have boilerplate' );
+
+ # should print arguments within this array
+ like( $file, qr/qw\(myarg\);/, 'should have written array to file' );
+}
+
+
+# overwrite this file (may whack portability, but the name's too good to waste)
+$file_is_ready = open(OUT, '>dasboot.bs');
+
+SKIP: {
+ skip("cannot make dasboot.bs again: $!", 1) unless $file_is_ready;
+ close OUT;
+
+ # if $DynaLoader::bscode is set, write its contents to the file
+ $DynaLoader::bscode = 'Wall';
+ $ExtUtils::Mkbootstrap::Verbose = 0;
+
+ # if arguments contain '-l' or '-L' or '-R' print dl_findfile message
+ eval{ Mkbootstrap('dasboot', '-Larry') };
+ is( $@, '', 'should be able to open a file again');
+
+ $file_is_ready = open(IN, 'dasboot.bs');
+}
+
+SKIP: {
+ skip("cannot open dasboot.bs for reading: $!", 3) unless $file_is_ready;
+
+ my $file = do { local $/ = <IN> };
+ is( $out->read, "Writing dasboot.bs\n", 'should hush without Verbose set' );
+
+ # and find our hidden tribute to a fine example
+ like( $file, qr/dl_findfile.+Larry/s, 'should load libraries if needed' );
+ like( $file, qr/Wall\n1;\n/ms, 'should write $DynaLoader::bscode if set' );
+}
+
+close IN;
+close OUT;
+
+END {
+ # clean things up, even on VMS
+ 1 while unlink(qw( mkboot.bso boot_BS dasboot.bs .bs ));
+}
+
+package TieOut;
+
+sub TIEHANDLE {
+ bless( \(my $scalar), $_[0]);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join('', @_);
+}
+
+sub read {
+ my $self = shift;
+ return substr($$self, 0, length($$self), '');
+}
==== //depot/perl/lib/ExtUtils/t/Packlist.t#1 (text) ====
Index: perl/lib/ExtUtils/t/Packlist.t
--- perl/lib/ExtUtils/t/Packlist.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/Packlist.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,167 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 34;
+
+use_ok( 'ExtUtils::Packlist' );
+
+is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' );
+
+# new calls tie()
+my $pl = ExtUtils::Packlist->new();
+isa_ok( $pl, 'ExtUtils::Packlist' );
+is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' );
+
+
+$pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' );
+is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' );
+is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' );
+
+
+ExtUtils::Packlist::STORE($pl, 'key', 'value');
+is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' );
+
+
+$pl->{data}{foo} = 'bar';
+is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' );
+
+
+# test FIRSTKEY and NEXTKEY
+SKIP: {
+ $pl->{data}{bar} = 'baz';
+ skip('not enough keys to test FIRSTKEY', 2) unless %{ $pl->{data} } > 2;
+
+ # get the first and second key
+ my ($first, $second) = keys %{ $pl->{data} };
+
+ # now get a couple of extra keys, to mess with the hash iterator
+ my $i = 0;
+ for (keys %{ $pl->{data} } ) {
+ last if $i++;
+ }
+
+ # finally, see if it really can get the first key again
+ is( ExtUtils::Packlist::FIRSTKEY($pl), $first,
+ 'FIRSTKEY() should be consistent' );
+
+ is( ExtUtils::Packlist::NEXTKEY($pl), $second,
+ 'and NEXTKEY() should also be consistent' );
+}
+
+
+ok( ExtUtils::Packlist::EXISTS($pl, 'bar'), 'EXISTS() should find keys' );
+
+
+ExtUtils::Packlist::DELETE($pl, 'bar');
+ok( !(exists $pl->{data}{bar}), 'DELETE() should delete cleanly' );
+
+
+ExtUtils::Packlist::CLEAR($pl);
+is( keys %{ $pl->{data} }, 0, 'CLEAR() should wipe out data' );
+
+
+# DESTROY does nothing...
+can_ok( 'ExtUtils::Packlist', 'DESTROY' );
+
+
+# write is a little more complicated
+eval { ExtUtils::Packlist::write({}) };
+like( $@, qr/No packlist filename/, 'write() should croak without packfile' );
+
+eval { ExtUtils::Packlist::write({}, 'eplist') };
+my $file_is_ready = $@ ? 0 : 1;
+ok( $file_is_ready, 'write() can write a file' );
+
+local *IN;
+
+SKIP: {
+ skip('cannot write files, some tests difficult', 3) unless $file_is_ready;
+
+ # set this file to read-only
+ chmod 0444, 'eplist';
+
+ SKIP: {
+ skip("can write readonly files", 1) if -w 'eplist';
+
+ eval { ExtUtils::Packlist::write({}, 'eplist') };
+ like( $@, qr/Can't open file/, 'write() should croak on open failure' );
+ }
+
+ #'now set it back (tick here fixes vim syntax highlighting ;)
+ chmod 0777, 'eplist';
+
+ # and some test data to be read
+ $pl->{data} = {
+ single => 1,
+ hash => {
+ foo => 'bar',
+ baz => 'bup',
+ },
+ '/./abc' => '',
+ };
+ eval { ExtUtils::Packlist::write($pl, 'eplist') };
+ is( $@, '', 'write() should normally succeed' );
+ is( $pl->{packfile}, 'eplist', 'write() should set packfile name' );
+
+ $file_is_ready = open(IN, 'eplist');
+}
+
+
+eval { ExtUtils::Packlist::read({}) };
+like( $@, qr/^No packlist filename/, 'read() should croak without packfile' );
+
+
+eval { ExtUtils::Packlist::read({}, 'abadfilename') };
+like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' );
+#'open packfile for reading
+
+
+# and more read() tests
+SKIP: {
+ skip("cannot open file for reading: $!", 5) unless $file_is_ready;
+ my $file = do { local $/ = <IN> };
+
+ like( $file, qr/single\n/, 'key with value should be available' );
+ like( $file, qr!/\./abc\n!, 'key with no value should also be present' );
+ like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' );
+ like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear');
+ close IN;
+
+ eval{ ExtUtils::Packlist::read($pl, 'eplist') };
+ is( $@, '', 'read() should normally succeed' );
+ is( $pl->{data}{single}, undef, 'single keys should have undef value' );
+ is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes');
+
+ is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' );
+ ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' );
+
+ # give validate a valid and an invalid file to find
+ $pl->{data} = {
+ eplist => 1,
+ fake => undef,
+ };
+
+ is( ExtUtils::Packlist::validate($pl), 1,
+ 'validate() should find missing files' );
+ ExtUtils::Packlist::validate($pl, 1);
+ ok( !exists $pl->{data}{fake},
+ 'validate() should remove missing files when prompted' );
+
+ # one more new() test, to see if it calls read() successfully
+ $pl = ExtUtils::Packlist->new('eplist');
+}
+
+
+# packlist_file, $pl should be set from write test
+is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl',
+ 'packlist_file() should fetch packlist from passed hash' );
+is( ExtUtils::Packlist::packlist_file($pl), 'eplist',
+ 'packlist_file() should fetch packlist from ExtUtils::Packlist object' );
+
+END {
+ 1 while unlink qw( eplist );
+}
==== //depot/perl/lib/ExtUtils/t/testlib.t#1 (text) ====
Index: perl/lib/ExtUtils/t/testlib.t
--- perl/lib/ExtUtils/t/testlib.t.~1~ Mon Dec 17 11:00:06 2001
+++ perl/lib/ExtUtils/t/testlib.t Mon Dec 17 11:00:06 2001
@@ -0,0 +1,16 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 3;
+
+my @blib_paths = grep { /blib/ } @INC;
+is( @blib_paths, 0, 'No blib dirs yet in @INC' );
+
+use_ok( 'ExtUtils::testlib' );
+
+@blib_paths = grep { /blib/ } @INC;
+is( @blib_paths, 2, 'ExtUtils::testlib added two @INC dirs!' );
End of Patch.
