This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add test for File::stat.
[perl5.git] / t / lib / ftmp-tempfile.t
CommitLineData
51fc852f 1#!/usr/local/bin/perl -w
262eb13a
GS
2# Test for File::Temp - tempfile function
3
e2cf2bdb
JH
4BEGIN {
5 chdir 't' if -d 't';
20822f61 6 @INC = '../lib';
e2cf2bdb 7 require Test; import Test;
09d7a2f9 8 plan(tests => 20);
e2cf2bdb
JH
9}
10
262eb13a 11use strict;
262eb13a 12use File::Spec;
262eb13a
GS
13
14# Will need to check that all files were unlinked correctly
51fc852f
TJ
15# Set up an END block here to do it
16
17# Arrays containing list of dirs/files to test
18my (@files, @dirs, @still_there);
19
20# And a test for files that should still be around
21# These are tidied up
22END {
23 foreach (@still_there) {
24 ok( -f $_ );
25 ok( unlink( $_ ) );
26 ok( !(-f $_) );
27 }
28}
262eb13a
GS
29
30# Loop over an array hoping that the files dont exist
1c19c868 31END { foreach (@files) { ok( !(-e $_) )} }
262eb13a
GS
32
33# And a test for directories
51fc852f 34END { foreach (@dirs) { ok( !(-d $_) )} }
1c19c868
JH
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
40use File::Temp qw/ tempfile tempdir/;
41
42# Now we start the tests properly
43ok(1);
262eb13a
GS
44
45
46# Tempfile
47# Open tempfile in some directory, unlink at end
48my ($fh, $tempfile) = tempfile(
49 UNLINK => 1,
50 SUFFIX => '.txt',
51 );
52
53ok( (-f $tempfile) );
09d7a2f9
TJ
54# Should still be around after closing
55ok( close( $fh ) );
56ok( (-f $tempfile) );
57# Check again at exit
262eb13a
GS
58push(@files, $tempfile);
59
60# TEMPDIR test
61# Create temp directory in current dir
62my $template = 'tmpdirXXXXXX';
63print "# Template: $template\n";
64my $tempdir = tempdir( $template ,
65 DIR => File::Spec->curdir,
66 CLEANUP => 1,
67 );
68
69print "# TEMPDIR: $tempdir\n";
70
71ok( (-d $tempdir) );
72push(@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
81print "# TEMPFILE: Created $tempfile\n";
82
83ok( (-f $tempfile));
84push(@files, $tempfile);
85
86# Test tempfile
87# ..and again
88($fh, $tempfile) = tempfile(
89 DIR => $tempdir,
90 );
91
92
93ok( (-f $tempfile ));
94push(@files, $tempfile);
95
96print "# 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
106print "# TEMPFILE: Created $tempfile\n";
107
108ok( (-f $tempfile) );
109push(@files, $tempfile);
110
51fc852f
TJ
111
112# Create a temporary file that should stay around after
113# it has been closed
114($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
115print "# TEMPFILE: Created $tempfile\n";
116ok( -f $tempfile );
117ok( close( $fh ) );
118push( @still_there, $tempfile); # check at END
119
09d7a2f9
TJ
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
130if ($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 144print "# End of tests. Execute END blocks\n";
1c19c868 145