diff options
Diffstat (limited to 'gnu/usr.bin/perl/lib/File')
| -rw-r--r-- | gnu/usr.bin/perl/lib/File/Copy.pm | 7 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/File/Copy.t | 41 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/File/stat.pm | 12 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/lib/File/stat.t | 2 |
4 files changed, 39 insertions, 23 deletions
diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm index f7440b3d7b0..b796451e37a 100644 --- a/gnu/usr.bin/perl/lib/File/Copy.pm +++ b/gnu/usr.bin/perl/lib/File/Copy.pm @@ -24,7 +24,7 @@ sub syscopy; sub cp; sub mv; -$VERSION = '2.31_01'; +$VERSION = '2.33'; require Exporter; @ISA = qw(Exporter); @@ -481,6 +481,11 @@ from the input filespec, then all timestamps other than the revision date are propagated. If this parameter is not supplied, it defaults to 0. +C<rmscopy> is VMS specific and cannot be exported; it must be +referenced by its full name, e.g.: + + File::Copy::rmscopy($from, $to) or die $!; + Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs, it sets C<$!>, deletes the output file, and returns 0. diff --git a/gnu/usr.bin/perl/lib/File/Copy.t b/gnu/usr.bin/perl/lib/File/Copy.t index 5dd564dad29..57d9478a68b 100644 --- a/gnu/usr.bin/perl/lib/File/Copy.t +++ b/gnu/usr.bin/perl/lib/File/Copy.t @@ -48,14 +48,14 @@ for my $cross_partition_test (0..1) { } # First we create a file - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; binmode F; # for DOSISH platforms, because test 3 copies to stdout printf F "ok\n"; close F; copy "file-$$", "copy-$$"; - open(F, "copy-$$") or die $!; + open(F, "<", "copy-$$") or die $!; my $foo = <F>; close(F); @@ -70,16 +70,18 @@ for my $cross_partition_test (0..1) { $TB->current_test($TB->current_test + 1); unlink "copy-$$" or die "unlink: $!"; - open(F,"file-$$"); + open(F, "<", "file-$$"); + binmode F; copy(*F, "copy-$$"); - open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R); + open(R, "<:raw", "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R); is $foo, "ok\n", 'copy(*F, fn): same contents'; unlink "copy-$$" or die "unlink: $!"; - open(F,"file-$$"); + open(F, "<", "file-$$"); + binmode F; copy(\*F, "copy-$$"); close(F) or die "close: $!"; - open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!"; + open(R, "<", "copy-$$") or die; $foo = <R>; close(R) or die "close: $!"; is $foo, "ok\n", 'copy(\*F, fn): same contents'; unlink "copy-$$" or die "unlink: $!"; @@ -88,7 +90,7 @@ for my $cross_partition_test (0..1) { binmode $fh or die $!; copy("file-$$",$fh); $fh->close or die "close: $!"; - open(R, "copy-$$") or die; $foo = <R>; close(R); + open(R, "<", "copy-$$") or die; $foo = <R>; close(R); is $foo, "ok\n", 'copy(fn, io): same contents'; unlink "copy-$$" or die "unlink: $!"; @@ -97,7 +99,7 @@ for my $cross_partition_test (0..1) { binmode $fh or die $!; copy("file-$$",$fh); $fh->close; - open(R, "copy-$$") or die $!; $foo = <R>; close(R); + open(R, "<", "copy-$$") or die $!; $foo = <R>; close(R); is $foo, "ok\n", 'copy(fn, fh): same contents'; unlink "file-$$" or die "unlink: $!"; @@ -116,7 +118,7 @@ for my $cross_partition_test (0..1) { ok move("copy-$$", "file-$$"), 'move'; ok -e "file-$$", ' destination exists'; ok !-e "copy-$$", ' source does not'; - open(R, "file-$$") or die $!; $foo = <R>; close(R); + open(R, "<", "file-$$") or die $!; $foo = <R>; close(R); is $foo, "ok\n", 'contents preserved'; TODO: { @@ -131,13 +133,13 @@ for my $cross_partition_test (0..1) { # trick: create lib/ if not exists - not needed in Perl core unless (-d 'lib') { mkdir 'lib' or die $!; } copy "file-$$", "lib"; - open(R, "lib/file-$$") or die $!; $foo = <R>; close(R); + open(R, "<", "lib/file-$$") or die $!; $foo = <R>; close(R); is $foo, "ok\n", 'copy(fn, dir): same contents'; unlink "lib/file-$$" or die "unlink: $!"; # Do it twice to ensure copying over the same file works. copy "file-$$", "lib"; - open(R, "lib/file-$$") or die $!; $foo = <R>; close(R); + open(R, "<", "lib/file-$$") or die $!; $foo = <R>; close(R); is $foo, "ok\n", 'copy over the same file works'; unlink "lib/file-$$" or die "unlink: $!"; @@ -151,7 +153,7 @@ for my $cross_partition_test (0..1) { } move "file-$$", "lib"; - open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R); + open(R, "<", "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R); is $foo, "ok\n", 'move(fn, dir): same contents'; ok !-e "file-$$", 'file moved indeed'; unlink "lib/file-$$" or die "unlink: $!"; @@ -159,7 +161,7 @@ for my $cross_partition_test (0..1) { SKIP: { skip "Testing symlinks", 3 unless $Config{d_symlink}; - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; print F "dummy content\n"; close F; symlink("file-$$", "symlink-$$") or die $!; @@ -180,7 +182,7 @@ for my $cross_partition_test (0..1) { skip "Testing hard links", 3 if !$Config{d_link} or $^O eq 'MSWin32' or $^O eq 'cygwin'; - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; print F "dummy content\n"; close F; link("file-$$", "hardlink-$$") or die $!; @@ -197,13 +199,13 @@ for my $cross_partition_test (0..1) { unlink "file-$$" or die $!; } - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; binmode F; print F "this is file\n"; close F; my $copy_msg = "this is copy\n"; - open(F, ">copy-$$") or die $!; + open(F, ">", "copy-$$") or die $!; binmode F; print F $copy_msg; close F; @@ -221,7 +223,7 @@ for my $cross_partition_test (0..1) { } is -s "copy-$$", length $copy_msg, "but does not truncate the destination"; - open(F, "copy-$$") or die $!; + open(F, "<", "copy-$$") or die $!; $foo = <F>; close(F); is $foo, $copy_msg, "nor change the destination's contents"; @@ -233,7 +235,7 @@ for my $cross_partition_test (0..1) { TODO: { local $TODO = 'spaces in filenames require DECC$EFS_CHARSET enabled' if $^O eq 'VMS'; - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; close F; copy "file-$$", " copy-$$"; ok -e " copy-$$", "copy with leading whitespace"; @@ -350,6 +352,7 @@ SKIP: { chmod $c_perm3 => $copy6 or die $!; open my $fh => "<", $src or die $!; + binmode $fh; copy ($src, $copy1); copy ($fh, $copy2); @@ -470,6 +473,8 @@ SKIP: { open(my $IN, "-|") || exec $^X, '-e', 'print "Hello, world!\n"'; open(my $OUT, "|-") || exec $^X, '-ne', 'exit(/Hello/ ? 55 : 0)'; + binmode $IN; + binmode $OUT; ok(copy($IN, $OUT), "copy pipe to another"); close($OUT); diff --git a/gnu/usr.bin/perl/lib/File/stat.pm b/gnu/usr.bin/perl/lib/File/stat.pm index b631fbf8752..578c3118c86 100644 --- a/gnu/usr.bin/perl/lib/File/stat.pm +++ b/gnu/usr.bin/perl/lib/File/stat.pm @@ -10,9 +10,16 @@ BEGIN { *warnif = \&warnings::warnif } our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); -our $VERSION = '1.07'; +our $VERSION = '1.08'; + +our @fields; +our ( $st_dev, $st_ino, $st_mode, + $st_nlink, $st_uid, $st_gid, + $st_rdev, $st_size, + $st_atime, $st_mtime, $st_ctime, + $st_blksize, $st_blocks +); -my @fields; BEGIN { use Exporter (); @EXPORT = qw(stat lstat); @@ -25,7 +32,6 @@ BEGIN { @EXPORT_OK = ( @fields, "stat_cando" ); %EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] ); } -use vars @fields; use Fcntl qw(S_IRUSR S_IWUSR S_IXUSR); diff --git a/gnu/usr.bin/perl/lib/File/stat.t b/gnu/usr.bin/perl/lib/File/stat.t index 7c9b9cc340b..c403fc44980 100644 --- a/gnu/usr.bin/perl/lib/File/stat.t +++ b/gnu/usr.bin/perl/lib/File/stat.t @@ -144,7 +144,7 @@ for (split //, "tTB") { SKIP: { local *STAT; - skip("Could not open file: $!", 2) unless open(STAT, $file); + skip("Could not open file: $!", 2) unless open(STAT, '<', $file); isa_ok(File::stat::stat('STAT'), 'File::stat', '... should be able to find filehandle'); |