perl 5.8.2 from CPAN

3 files changed, 232 insertions, 7 deletions

diff --git a/gnu/usr.bin/perl/lib/File/Find/t/find.t b/gnu/usr.bin/perl/lib/File/Find/t/find.t
index c28183348f3..c55b4a9aac0 100644
--- a/gnu/usr.bin/perl/lib/File/Find/t/find.t
+++ b/gnu/usr.bin/perl/lib/File/Find/t/find.t
@@ -15,8 +15,8 @@ BEGIN {
     $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }
 }
 
-if ( $symlink_exists ) { print "1..188\n"; }
-else                   { print "1..78\n";  }
+if ( $symlink_exists ) { print "1..189\n"; }
+else                   { print "1..79\n";  }
 
 # Uncomment this to see where File::Find is chdir'ing to.  Helpful for
 # debugging its little jaunts around the filesystem.
@@ -51,12 +51,23 @@ BEGIN {
 
 cleanup();
 
-find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; } },
+$::count_commonsense = 0;
+find({wanted => sub { ++$::count_commonsense if $_ eq 'commonsense.t'; } },
    File::Spec->curdir);
+if ($::count_commonsense == 1) {
+  print "ok 1\n";
+} else {
+  print "not ok 1 # found $::count_commonsense files named 'commonsense.t'\n";
+}
 
-finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; } },
+$::count_commonsense = 0;
+finddepth({wanted => sub { ++$::count_commonsense if $_ eq 'commonsense.t'; } },
 	File::Spec->curdir);
-
+if ($::count_commonsense == 1) {
+  print "ok 2\n";
+} else {
+  print "not ok 2 # found $::count_commonsense files named 'commonsense.t'\n";
+}
 
 my $case = 2;
 my $FastFileTests_OK = 0;
@@ -473,6 +484,18 @@ File::Find::find( {wanted => \&noop_wanted,
 
 Check( scalar(keys %Expect_Dir) == 0 );
 
+{
+    print "# checking argument localization\n";
+
+    ### this checks the fix of perlbug [19977] ###
+    my @foo = qw( a b c d e f );
+    my %pre = map { $_ => } @foo;
+
+    File::Find::find( sub {  } , 'fa' ) for @foo;
+    delete $pre{$_} for @foo;
+
+    Check( scalar( keys %pre ) == 0 );
+}
 
 if ( $symlink_exists ) {
     print "# --- symbolic link tests --- \n";
@@ -750,5 +773,4 @@ if ( $symlink_exists ) {
     Check( scalar(keys %Expect_File) == 0 );
     unlink file_path('fa', 'faa_sl');
 
-} 
-
+}
diff --git a/gnu/usr.bin/perl/lib/File/Spec/t/crossplatform.t b/gnu/usr.bin/perl/lib/File/Spec/t/crossplatform.t
new file mode 100644
index 00000000000..a98e091b3a4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Spec/t/crossplatform.t
@@ -0,0 +1,96 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use File::Spec;
+local $|=1;
+
+my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32);
+my $tests_per_platform = 7;
+
+plan tests => 1 + @platforms * $tests_per_platform;
+
+my %volumes = (
+	       Mac => 'Macintosh HD',
+	       OS2 => 'A:',
+	       Win32 => 'A:',
+	       VMS => 'v',
+	      );
+my %other_vols = (
+		  Mac => 'Mounted Volume',
+		  OS2 => 'B:',
+		  Win32 => 'B:',
+		  VMS => 'w',
+	      );
+
+ok 1, "Loaded";
+
+foreach my $platform (@platforms) {
+  my $module = "File::Spec::$platform";
+  
+ SKIP:
+  {
+    eval "require $module; 1";
+
+    skip "Can't load $module", $tests_per_platform
+      if $@;
+    
+    my $v = $volumes{$platform} || '';
+    my $other_v = $other_vols{$platform} || '';
+    
+    # Fake out the rootdir on MacOS
+    no strict 'refs';
+    my $save_w = $^W;
+    $^W = 0;
+    local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" };
+    $^W = $save_w;
+    use strict 'refs';
+    
+    my ($file, $base, $result);
+
+    $base = $module->catpath($v, $module->catdir('', 'foo'), '');
+    $base = $module->catdir($module->rootdir, 'foo');
+
+    is $module->file_name_is_absolute($base), 1, "$base is absolute on $platform";
+
+
+    # abs2rel('A:/foo/bar', 'A:/foo')    ->  'bar'
+    $file = $module->catpath($v, $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
+    $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
+    $result = $module->catfile('bar', 'file');
+    is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+    
+    # abs2rel('A:/foo/bar', 'B:/foo')    ->  'A:/foo/bar'
+    $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), '');
+    $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
+    is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+    # abs2rel('A:/foo/bar', '/foo')      ->  'A:/foo/bar'
+    $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), '');
+    $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
+    is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+
+    # abs2rel('/foo/bar', 'A:/foo')    ->  '/foo/bar'
+    $file = $module->catpath('', $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
+    $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
+    $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
+    is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+    
+    # abs2rel('/foo/bar', 'B:/foo')    ->  '/foo/bar'
+    $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), '');
+    $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
+    is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+    
+    # abs2rel('/foo/bar', '/foo')      ->  'bar'
+    $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), '');
+    $result = $module->catfile('bar', 'file');
+    is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
+  }
+}
+
+sub volumes_differ {
+  my ($module, $one, $two) = @_;
+  my ($one_v) = $module->splitpath( $module->rel2abs($one) );
+  my ($two_v) = $module->splitpath( $module->rel2abs($two) );
+  return $one_v ne $two_v;
+}
diff --git a/gnu/usr.bin/perl/lib/File/Temp/t/object.t b/gnu/usr.bin/perl/lib/File/Temp/t/object.t
new file mode 100644
index 00000000000..5828866f0fd
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Temp/t/object.t
@@ -0,0 +1,107 @@
+#!/usr/local/bin/perl -w
+# Test for File::Temp - OO interface
+
+use strict;
+use Test::More tests => 18;
+use File::Spec;
+
+# Will need to check that all files were unlinked correctly
+# Set up an END block here to do it
+
+# Arrays containing list of dirs/files to test
+my (@files, @dirs, @still_there);
+
+# And a test for files that should still be around
+# These are tidied up
+END {
+  foreach (@still_there) {
+    ok( -f $_, "Check $_ exists" );
+    ok( unlink( $_ ), "Unlinked $_" );
+    ok( !(-f $_), "$_ no longer there");
+  }
+}
+
+# Loop over an array hoping that the files dont exist
+END { foreach (@files) { ok( !(-e $_), "File $_ should not be there" )} }
+
+# And a test for directories
+END { foreach (@dirs)  { ok( !(-d $_), "Directory $_ should not be there" ) } }
+
+# Need to make sure that the END blocks are setup before
+# the ones that File::Temp configures since END blocks are evaluated
+# in reverse order and we need to check the files *after* File::Temp
+# removes them
+BEGIN {use_ok( "File::Temp" ); }
+
+# Tempfile
+# Open tempfile in some directory, unlink at end
+my $fh = new File::Temp( SUFFIX => '.txt' );
+
+ok( (-f "$fh"), "File $fh exists"  );
+# Should still be around after closing
+ok( close( $fh ), "Close file $fh" );
+ok( (-f "$fh"), "File $fh still exists after close" );
+# Check again at exit
+push(@files, "$fh");
+
+# TEMPDIR test
+# Create temp directory in current dir
+my $template = 'tmpdirXXXXXX';
+print "# Template: $template\n";
+my $tempdir = File::Temp::tempdir( $template ,
+				   DIR => File::Spec->curdir,
+				   CLEANUP => 1,
+				 );
+
+print "# TEMPDIR: $tempdir\n";
+
+ok( (-d $tempdir), "Does $tempdir directory exist" );
+push(@dirs, $tempdir);
+
+# Create file in the temp dir
+$fh = new File::Temp(
+		     DIR => $tempdir,
+		     SUFFIX => '.dat',
+		    );
+
+print "# TEMPFILE: Created $fh\n";
+
+ok( (-f "$fh"), "File $fh exists in tempdir?");
+push(@files, "$fh");
+
+# Test tempfile
+# ..and again (without unlinking it)
+$fh = new File::Temp( DIR => $tempdir, UNLINK => 0 );
+
+print "# TEMPFILE: Created $fh\n";
+ok( (-f "$fh" ), "Second file $fh exists in tempdir [nounlink]?");
+push(@files, "$fh");
+
+# and another (with template)
+
+$fh = new File::Temp( TEMPLATE => 'helloXXXXXXX',
+		      DIR => $tempdir,
+		      SUFFIX => '.dat',
+		    );
+
+print "# TEMPFILE: Created $fh\n";
+
+ok( (-f "$fh"), "File $fh exists? [from template]" );
+push(@files, "$fh");
+
+
+# Create a temporary file that should stay around after
+# it has been closed
+$fh = new File::Temp( TEMPLATE => 'permXXXXXXX', UNLINK => 0);
+
+print "# TEMPFILE: Created $fh\n";
+ok( -f "$fh", "File $fh exists?" );
+ok( close( $fh ), "Close file $fh" );
+push( @still_there, "$fh"); # check at END
+
+# Make sure destructors run
+undef $fh;
+
+# Now END block will execute to test the removal of directories
+print "# End of tests. Execute END blocks\n";
+