1 #!/usr/local/bin/perl -w
2 # Test for File::Temp - tempfile function
7 require Test; import Test;
14 # Will need to check that all files were unlinked correctly
15 # Set up an END block here to do it
17 # Arrays containing list of dirs/files to test
18 my (@files, @dirs, @still_there);
20 # And a test for files that should still be around
23 foreach (@still_there) {
30 # Loop over an array hoping that the files dont exist
31 END { foreach (@files) { ok( !(-e $_) )} }
33 # And a test for directories
34 END { foreach (@dirs) { ok( !(-d $_) )} }
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
40 use File::Temp qw/ tempfile tempdir/;
42 # Now we start the tests properly
47 # Open tempfile in some directory, unlink at end
48 my ($fh, $tempfile) = tempfile(
54 # Should still be around after closing
58 push(@files, $tempfile);
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,
69 print "# TEMPDIR: $tempdir\n";
72 push(@dirs, $tempdir);
74 # Create file in the temp dir
75 ($fh, $tempfile) = tempfile(
81 print "# TEMPFILE: Created $tempfile\n";
84 push(@files, $tempfile);
88 ($fh, $tempfile) = tempfile(
94 push(@files, $tempfile);
96 print "# TEMPFILE: Created $tempfile\n";
98 # and another (with template)
100 ($fh, $tempfile) = tempfile( 'helloXXXXXXX',
106 print "# TEMPFILE: Created $tempfile\n";
108 ok( (-f $tempfile) );
109 push(@files, $tempfile);
112 # Create a temporary file that should stay around after
114 ($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
115 print "# TEMPFILE: Created $tempfile\n";
118 push( @still_there, $tempfile); # check at END
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
124 # - The unlink0 required on unix for tempfile creation will fail
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 ) };
132 # print something to it to make sure something is there
133 ok( print $fh "Test\n" );
135 # Close it - can not check it is gone since we dont know the name
139 skip "Skip Failed probably due to NFS", 1;
140 skip "Skip Failed probably due to NFS", 1;
143 # Now END block will execute to test the removal of directories
144 print "# End of tests. Execute END blocks\n";