1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!/usr/bin/perl -w
# Test for mktemp family of commands in File::Temp
# Use STANDARD safe level for these tests
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Test; import Test;
plan(tests => 9);
}
use strict;
use File::Spec;
use File::Path;
use File::Temp qw/ :mktemp unlink0 /;
use FileHandle;
ok(1);
# MKSTEMP - test
# Create file in temp directory
my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
(my $fh, $template) = mkstemp($template);
print "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n";
# Check if the file exists
ok( (-e $template) );
# Autoflush
$fh->autoflush(1) if $] >= 5.006;
# Try printing something to the file
my $string = "woohoo\n";
print $fh $string;
# rewind the file
ok(seek( $fh, 0, 0));
# Read from the file
my $line = <$fh>;
# compare with previous string
ok($string, $line);
# Tidy up
# This test fails on Windows NT since it seems that the size returned by
# stat(filehandle) does not always equal the size of the stat(filename)
# This must be due to caching. In particular this test writes 7 bytes
# to the file which are not recognised by stat(filename)
# Simply waiting 3 seconds seems to be enough for the system to update
if ($^O eq 'MSWin32') {
sleep 3;
}
ok( unlink0($fh, $template) );
# MKSTEMPS
# File with suffix. This is created in the current directory
$template = "suffixXXXXXX";
my $suffix = ".dat";
($fh, my $fname) = mkstemps($template, $suffix);
print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n";
# Check if the file exists
ok( (-e $fname) );
# This fails if you are running on NFS
# If this test fails simply skip it rather than doing a hard failure
my $status = unlink0($fh, $fname);
if ($status) {
ok($status);
} else {
skip("Skip test failed probably due to NFS",1)
}
# MKDTEMP
# Temp directory
$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
my $tmpdir = mkdtemp($template);
print "# MKDTEMP: Name is $tmpdir from template $template\n";
ok( (-d $tmpdir ) );
# Need to tidy up after myself
rmtree($tmpdir);
# MKTEMP
# Just a filename, not opened
$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
my $tmpfile = mktemp($template);
print "# MKTEMP: Tempfile is $template -> $tmpfile\n";
# Okay if template no longer has XXXXX in
ok( ($tmpfile !~ /XXXXX$/) );
|
