Commit | Line | Data |
51fc852f |
1 | #!/usr/local/bin/perl -w |
262eb13a |
2 | # Test for File::Temp - tempfile function |
3 | |
e2cf2bdb |
4 | BEGIN { |
5 | chdir 't' if -d 't'; |
20822f61 |
6 | @INC = '../lib'; |
e2cf2bdb |
7 | require Test; import Test; |
09d7a2f9 |
8 | plan(tests => 20); |
e2cf2bdb |
9 | } |
10 | |
262eb13a |
11 | use strict; |
262eb13a |
12 | use File::Spec; |
262eb13a |
13 | |
14 | # Will need to check that all files were unlinked correctly |
51fc852f |
15 | # Set up an END block here to do it |
16 | |
17 | # Arrays containing list of dirs/files to test |
18 | my (@files, @dirs, @still_there); |
19 | |
20 | # And a test for files that should still be around |
21 | # These are tidied up |
22 | END { |
23 | foreach (@still_there) { |
24 | ok( -f $_ ); |
25 | ok( unlink( $_ ) ); |
26 | ok( !(-f $_) ); |
27 | } |
28 | } |
262eb13a |
29 | |
30 | # Loop over an array hoping that the files dont exist |
1c19c868 |
31 | END { foreach (@files) { ok( !(-e $_) )} } |
262eb13a |
32 | |
33 | # And a test for directories |
51fc852f |
34 | END { foreach (@dirs) { ok( !(-d $_) )} } |
1c19c868 |
35 | |
36 | # Need to make sure that the END blocks are setup before |
37 | # the ones that File::Temp configures since END blocks are evaluated |
38 | # in revers order and we need to check the files *after* File::Temp |
39 | # removes them |
40 | use File::Temp qw/ tempfile tempdir/; |
41 | |
42 | # Now we start the tests properly |
43 | ok(1); |
262eb13a |
44 | |
45 | |
46 | # Tempfile |
47 | # Open tempfile in some directory, unlink at end |
48 | my ($fh, $tempfile) = tempfile( |
49 | UNLINK => 1, |
50 | SUFFIX => '.txt', |
51 | ); |
52 | |
53 | ok( (-f $tempfile) ); |
09d7a2f9 |
54 | # Should still be around after closing |
55 | ok( close( $fh ) ); |
56 | ok( (-f $tempfile) ); |
57 | # Check again at exit |
262eb13a |
58 | push(@files, $tempfile); |
59 | |
60 | # TEMPDIR test |
61 | # Create temp directory in current dir |
62 | my $template = 'tmpdirXXXXXX'; |
63 | print "# Template: $template\n"; |
64 | my $tempdir = tempdir( $template , |
65 | DIR => File::Spec->curdir, |
66 | CLEANUP => 1, |
67 | ); |
68 | |
69 | print "# TEMPDIR: $tempdir\n"; |
70 | |
71 | ok( (-d $tempdir) ); |
72 | push(@dirs, $tempdir); |
73 | |
74 | # Create file in the temp dir |
75 | ($fh, $tempfile) = tempfile( |
76 | DIR => $tempdir, |
77 | UNLINK => 1, |
78 | SUFFIX => '.dat', |
79 | ); |
80 | |
81 | print "# TEMPFILE: Created $tempfile\n"; |
82 | |
83 | ok( (-f $tempfile)); |
84 | push(@files, $tempfile); |
85 | |
86 | # Test tempfile |
87 | # ..and again |
88 | ($fh, $tempfile) = tempfile( |
89 | DIR => $tempdir, |
90 | ); |
91 | |
92 | |
93 | ok( (-f $tempfile )); |
94 | push(@files, $tempfile); |
95 | |
96 | print "# TEMPFILE: Created $tempfile\n"; |
97 | |
98 | # and another (with template) |
99 | |
100 | ($fh, $tempfile) = tempfile( 'helloXXXXXXX', |
101 | DIR => $tempdir, |
102 | UNLINK => 1, |
103 | SUFFIX => '.dat', |
104 | ); |
105 | |
106 | print "# TEMPFILE: Created $tempfile\n"; |
107 | |
108 | ok( (-f $tempfile) ); |
109 | push(@files, $tempfile); |
110 | |
51fc852f |
111 | |
112 | # Create a temporary file that should stay around after |
113 | # it has been closed |
114 | ($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 ); |
115 | print "# TEMPFILE: Created $tempfile\n"; |
116 | ok( -f $tempfile ); |
117 | ok( close( $fh ) ); |
118 | push( @still_there, $tempfile); # check at END |
119 | |
09d7a2f9 |
120 | # Would like to create a temp file and just retrieve the handle |
121 | # but the test is problematic since: |
122 | # - We dont know the filename so we cant check that it is tidied |
123 | # correctly |
124 | # - The unlink0 required on unix for tempfile creation will fail |
125 | # on NFS |
126 | # Try to do what we can. |
127 | # Tempfile croaks on error so we need an eval |
128 | $fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) }; |
129 | |
130 | if ($fh) { |
131 | |
132 | # print something to it to make sure something is there |
133 | ok( print $fh "Test\n" ); |
134 | |
135 | # Close it - can not check it is gone since we dont know the name |
136 | ok( close($fh) ); |
137 | |
138 | } else { |
139 | skip "Skip Failed probably due to NFS", 1; |
140 | skip "Skip Failed probably due to NFS", 1; |
141 | } |
142 | |
1c19c868 |
143 | # Now END block will execute to test the removal of directories |
09d7a2f9 |
144 | print "# End of tests. Execute END blocks\n"; |
1c19c868 |
145 | |