summaryrefslogtreecommitdiff
path: root/lib/File
diff options
context:
space:
mode:
authorCraig A. Berry <craigberry@mac.com>2009-06-11 07:19:30 -0500
committerCraig A. Berry <craigberry@mac.com>2009-06-11 12:30:53 -0500
commit937f2ad5ba73ddf03d0fc5ae95784123a6acab55 (patch)
treed0a0fdada849998eb44abf2edbe53ea6bafc3d37 /lib/File
parentfcac5cf14997b354a7158a10465a31469cf66656 (diff)
downloadperl-937f2ad5ba73ddf03d0fc5ae95784123a6acab55.tar.gz
Make Compare.t work when filenames can't have whitespace.
Plus make sure a file to be compared by name is closed before comparison on VMS.
Diffstat (limited to 'lib/File')
-rw-r--r--lib/File/Compare.t27
1 files changed, 18 insertions, 9 deletions
diff --git a/lib/File/Compare.t b/lib/File/Compare.t
index 2685077b36..7a31af68f1 100644
--- a/lib/File/Compare.t
+++ b/lib/File/Compare.t
@@ -72,15 +72,13 @@ print "ok 8\n";
my @donetests;
eval {
- require File::Spec; import File::Spec;
- require File::Path; import File::Path;
- require File::Temp; import File::Temp qw/ :mktemp unlink0 /;
+ require File::Temp; import File::Temp qw/ tempfile unlink0 /;
- my $template = File::Spec->catfile(File::Spec->tmpdir, 'fcmpXXXX');
- my($tfh,$filename) = mkstemp($template);
+ my($tfh,$filename) = tempfile('fcmpXXXX', TMPDIR => 1);
# NB. The trailing space is intentional (see [perl #37716])
- open my $tfhSP, ">", "$filename "
- or die "Could not open '$filename ' for writing: $!";
+ my $whsp = get_valid_whitespace();
+ open my $tfhSP, ">", "$filename$whsp"
+ or die "Could not open '$filename$whsp' for writing: $!";
binmode($tfhSP);
{
local $/; #slurp
@@ -95,10 +93,14 @@ eval {
}
seek($tfh,0,0);
$donetests[0] = compare($tfh, 'README');
+ if ($^O eq 'VMS') {
+ unlink0($tfh,$filename); # queue for later removal
+ close $tfh; # may not be opened shared
+ }
$donetests[1] = compare($filename, 'README');
unlink0($tfh,$filename);
- $donetests[2] = compare('README', "$filename ");
- unlink "$filename ";
+ $donetests[2] = compare('README', "$filename$whsp");
+ unlink "$filename$whsp";
};
print "# problem '$@' when testing with a temporary file\n" if $@;
@@ -115,3 +117,10 @@ if (@donetests == 3) {
else {
print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n";
}
+
+sub get_valid_whitespace {
+ return ' ' unless $^O eq 'VMS';
+ return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i)
+ ? ' '
+ : '_'; # traditional mode eats spaces in filenames
+}