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