From 0121b80e4f69c2ad9631e8d20b5c91f3b2a40434 Mon Sep 17 00:00:00 2001 From: "Todd C. Miller" Date: Wed, 3 Dec 2003 02:44:40 +0000 Subject: perl 5.8.2 from CPAN --- gnu/usr.bin/perl/lib/File/Find/t/find.t | 36 ++++++-- gnu/usr.bin/perl/lib/File/Spec/t/crossplatform.t | 96 ++++++++++++++++++++ gnu/usr.bin/perl/lib/File/Temp/t/object.t | 107 +++++++++++++++++++++++ 3 files changed, 232 insertions(+), 7 deletions(-) create mode 100644 gnu/usr.bin/perl/lib/File/Spec/t/crossplatform.t create mode 100644 gnu/usr.bin/perl/lib/File/Temp/t/object.t (limited to 'gnu/usr.bin/perl/lib/File') 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"; + -- cgit v1.2.3