xref: /openbsd-src/gnu/usr.bin/perl/cpan/File-Temp/t/object.t (revision 256a93a44f36679bee503f12e49566c2183f6181)
1b39c5158Smillert#!/usr/local/bin/perl -w
2b39c5158Smillert# Test for File::Temp - OO interface
3b39c5158Smillert
4b39c5158Smillertuse strict;
591f110e0Safresh1use Test::More tests => 35;
6b39c5158Smillertuse File::Spec;
7b39c5158Smillert
8b39c5158Smillert# Will need to check that all files were unlinked correctly
9b39c5158Smillert# Set up an END block here to do it
10b39c5158Smillert
11b39c5158Smillert# Arrays containing list of dirs/files to test
12b39c5158Smillertmy (@files, @dirs, @still_there);
13b39c5158Smillert
14b39c5158Smillert# And a test for files that should still be around
15b39c5158Smillert# These are tidied up
16b39c5158SmillertEND {
17b39c5158Smillert  foreach (@still_there) {
18b39c5158Smillert    ok( -f $_, "Check $_ exists" );
19b39c5158Smillert    ok( unlink( $_ ), "Unlinked $_" );
20b39c5158Smillert    ok( !(-f $_), "$_ no longer there");
21b39c5158Smillert  }
22b39c5158Smillert}
23b39c5158Smillert
24b39c5158Smillert# Loop over an array hoping that the files dont exist
25b39c5158SmillertEND { foreach (@files) { ok( !(-e $_), "File $_ should not be there" )} }
26b39c5158Smillert
27b39c5158Smillert# And a test for directories
28b39c5158SmillertEND { foreach (@dirs)  { ok( !(-d $_), "Directory $_ should not be there" ) } }
29b39c5158Smillert
30b39c5158Smillert# Need to make sure that the END blocks are setup before
31b39c5158Smillert# the ones that File::Temp configures since END blocks are evaluated
32b39c5158Smillert# in reverse order and we need to check the files *after* File::Temp
33b39c5158Smillert# removes them
34b39c5158SmillertBEGIN {use_ok( "File::Temp" ); }
35b39c5158Smillert
3691f110e0Safresh1# Check for misuse
3791f110e0Safresh1eval { File::Temp->tempfile };
3891f110e0Safresh1like( $@, qr/can't be called as a method/, "File::Temp->tempfile error" );
3991f110e0Safresh1eval { File::Temp->tempdir };
4091f110e0Safresh1like( $@, qr/can't be called as a method/, "File::Temp->tempfile error" );
4191f110e0Safresh1
42b39c5158Smillert# Tempfile
43b39c5158Smillert# Open tempfile in some directory, unlink at end
44*256a93a4Safresh1my $fh = File::Temp->new( SUFFIX => '.txt' );
45b39c5158Smillert
46b39c5158Smillertok( (-f "$fh"), "File $fh exists"  );
47b39c5158Smillert# Should still be around after closing
48b39c5158Smillertok( close( $fh ), "Close file $fh" );
49b39c5158Smillertok( (-f "$fh"), "File $fh still exists after close" );
50b39c5158Smillert# Check again at exit
51b39c5158Smillertpush(@files, "$fh");
52b39c5158Smillert
53b39c5158Smillert# OO tempdir
54b39c5158Smillertmy $tdir = File::Temp->newdir();
55b39c5158Smillertmy $dirname = "$tdir"; # Stringify overload
56b39c5158Smillertok( -d $dirname, "Directory $tdir exists");
57b39c5158Smillertundef $tdir;
58b39c5158Smillertok( !-d $dirname, "Directory should now be gone");
59b39c5158Smillert
6091f110e0Safresh1# with template
6191f110e0Safresh1$tdir = File::Temp->newdir( TEMPLATE => 'helloXXXXX' );
6291f110e0Safresh1like( "$tdir", qr/hello/, "Directory with TEMPLATE" );
6391f110e0Safresh1undef $tdir;
6491f110e0Safresh1
6591f110e0Safresh1$tdir = File::Temp->newdir( 'helloXXXXX' );
6691f110e0Safresh1like( "$tdir", qr/hello/, "Directory with leading template" );
6791f110e0Safresh1undef $tdir;
6891f110e0Safresh1
69b39c5158Smillert# Quick basic tempfile test
70b39c5158Smillertmy $qfh = File::Temp->new();
71b39c5158Smillertmy $qfname = "$qfh";
72b39c5158Smillertok (-f $qfname, "temp file exists");
73b39c5158Smillertundef $qfh;
74b39c5158Smillertok( !-f $qfname, "temp file now gone");
75b39c5158Smillert
76b39c5158Smillert
77b39c5158Smillert# TEMPDIR test as somewhere to put the temp files
78b39c5158Smillert# Create temp directory in current dir
79b39c5158Smillertmy $template = 'tmpdirXXXXXX';
80b39c5158Smillertprint "# Template: $template\n";
81b39c5158Smillertmy $tempdir = File::Temp::tempdir( $template ,
82b39c5158Smillert				   DIR => File::Spec->curdir,
83b39c5158Smillert				   CLEANUP => 1,
84b39c5158Smillert				 );
85b39c5158Smillert
86b39c5158Smillertprint "# TEMPDIR: $tempdir\n";
87b39c5158Smillert
88b39c5158Smillertok( (-d $tempdir), "Does $tempdir directory exist" );
89b39c5158Smillertpush(@dirs, $tempdir);
90b39c5158Smillert
91b39c5158Smillert# Create file in the temp dir
92*256a93a4Safresh1$fh = File::Temp->new(
93b39c5158Smillert		     DIR => $tempdir,
94b39c5158Smillert		     SUFFIX => '.dat',
95b39c5158Smillert		    );
96b39c5158Smillert
97b39c5158Smillertok( $fh->unlink_on_destroy, "should unlink");
98b39c5158Smillertprint "# TEMPFILE: Created $fh\n";
99b39c5158Smillert
100b39c5158Smillertok( (-f "$fh"), "File $fh exists in tempdir?");
101b39c5158Smillertpush(@files, "$fh");
102b39c5158Smillert
103b39c5158Smillert# Test tempfile
104b39c5158Smillert# ..and again (without unlinking it)
105*256a93a4Safresh1$fh = File::Temp->new( DIR => $tempdir, UNLINK => 0 );
106b39c5158Smillert
107b39c5158Smillertprint "# TEMPFILE: Created $fh\n";
108b39c5158Smillertok( (-f "$fh" ), "Second file $fh exists in tempdir [nounlink]?");
109b39c5158Smillertpush(@files, "$fh");
110b39c5158Smillert
111b39c5158Smillert# and another (with template)
112b39c5158Smillert
113*256a93a4Safresh1$fh = File::Temp->new( TEMPLATE => 'helloXXXXXXX',
114b39c5158Smillert		      DIR => $tempdir,
115b39c5158Smillert		      SUFFIX => '.dat',
116b39c5158Smillert		    );
117b39c5158Smillert
118b39c5158Smillertprint "# TEMPFILE: Created $fh\n";
119b39c5158Smillert
12091f110e0Safresh1# and with a leading template
12191f110e0Safresh1$fh = File::Temp->new( 'helloXXXXXXX',
12291f110e0Safresh1		      DIR => $tempdir,
12391f110e0Safresh1		      SUFFIX => '.dat',
12491f110e0Safresh1		    );
12591f110e0Safresh1
12691f110e0Safresh1print "# TEMPFILE: Created $fh\n";
12791f110e0Safresh1
12891f110e0Safresh1ok( (-f "$fh"), "File $fh exists? [from leading template]" );
12991f110e0Safresh1like( "$fh", qr/hello/, "saw template" );
130b39c5158Smillertpush(@files, "$fh");
131b39c5158Smillert
132b39c5158Smillert
13391f110e0Safresh1
134b39c5158Smillert# Create a temporary file that should stay around after
135b39c5158Smillert# it has been closed
136*256a93a4Safresh1$fh = File::Temp->new( TEMPLATE => 'permXXXXXXX', UNLINK => 0);
137b39c5158Smillert
138b39c5158Smillertprint "# TEMPFILE: Created $fh\n";
139b39c5158Smillertok( -f "$fh", "File $fh exists?" );
140b39c5158Smillertok( close( $fh ), "Close file $fh" );
141b39c5158Smillertok( ! $fh->unlink_on_destroy, "should not unlink");
142b39c5158Smillertpush( @still_there, "$fh"); # check at END
143b39c5158Smillert
144b39c5158Smillert# Now create a temp file that will remain when the object
145b39c5158Smillert# goes out of scope because of $KEEP_ALL
146*256a93a4Safresh1$fh = File::Temp->new( TEMPLATE => 'permXXXXXXX', UNLINK => 1);
147b39c5158Smillert
148b39c5158Smillertprint "# TEMPFILE: Created $fh\n";
149b39c5158Smillertok( -f "$fh", "File $fh exists?" );
150b39c5158Smillertok( close( $fh ), "Close file $fh" );
151f3efcd01Safresh1ok( $fh->unlink_on_destroy, "should unlink (in principle)");
152b39c5158Smillertpush( @still_there, "$fh"); # check at END
153b39c5158Smillert$File::Temp::KEEP_ALL = 1;
154b39c5158Smillert
155b39c5158Smillert# Make sure destructors run
156b39c5158Smillertundef $fh;
157b39c5158Smillert
158b39c5158Smillert# allow end blocks to run
159b39c5158Smillert$File::Temp::KEEP_ALL = 0;
160b39c5158Smillert
161b39c5158Smillert# Now END block will execute to test the removal of directories
162b39c5158Smillertprint "# End of tests. Execute END blocks\n";
163b39c5158Smillert
164