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