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