This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
[perl5.git] / t / lib / ftmp-mktemp.t
CommitLineData
e2cf2bdb 1#!/usr/bin/perl -w
262eb13a
GS
2
3# Test for mktemp family of commands in File::Temp
4# Use STANDARD safe level for these tests
5
e2cf2bdb
JH
6BEGIN {
7 chdir 't' if -d 't';
20822f61 8 @INC = '../lib';
e2cf2bdb
JH
9 require Test; import Test;
10 plan(tests => 9);
11}
12
262eb13a 13use strict;
262eb13a
GS
14
15use File::Spec;
16use File::Path;
17use File::Temp qw/ :mktemp unlink0 /;
f5cf745e 18use FileHandle;
262eb13a
GS
19
20ok(1);
21
22# MKSTEMP - test
23
24# Create file in temp directory
25my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
26
27(my $fh, $template) = mkstemp($template);
28
29print "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n";
30# Check if the file exists
31ok( (-e $template) );
32
33# Autoflush
0e939f40 34$fh->autoflush(1) if $] >= 5.006;
262eb13a
GS
35
36# Try printing something to the file
37my $string = "woohoo\n";
38print $fh $string;
39
40# rewind the file
41ok(seek( $fh, 0, 0));
42
43# Read from the file
44my $line = <$fh>;
45
46# compare with previous string
47ok($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)
1c19c868 54# Simply waiting 3 seconds seems to be enough for the system to update
262eb13a
GS
55
56if ($^O eq 'MSWin32') {
57 sleep 3;
58}
0e939f40
JH
59my $status = unlink0($fh, $template);
60if ($status) {
61 ok( $status );
62} else {
63 skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
64}
262eb13a
GS
65
66# MKSTEMPS
0e939f40
JH
67# File with suffix. This is created in the current directory so
68# may be problematic on NFS
262eb13a
GS
69
70$template = "suffixXXXXXX";
71my $suffix = ".dat";
72
73($fh, my $fname) = mkstemps($template, $suffix);
74
75print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n";
76# Check if the file exists
77ok( (-e $fname) );
78
1c19c868
JH
79# This fails if you are running on NFS
80# If this test fails simply skip it rather than doing a hard failure
0e939f40 81$status = unlink0($fh, $fname);
262eb13a 82
1c19c868
JH
83if ($status) {
84 ok($status);
85} else {
0e939f40 86 skip("Skip test failed probably due to cwd being on NFS",1)
1c19c868 87}
262eb13a
GS
88
89# MKDTEMP
90# Temp directory
91
92$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
93
94my $tmpdir = mkdtemp($template);
95
96print "# MKDTEMP: Name is $tmpdir from template $template\n";
97
98ok( (-d $tmpdir ) );
99
100# Need to tidy up after myself
101rmtree($tmpdir);
102
103# MKTEMP
104# Just a filename, not opened
105
106$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
107
108my $tmpfile = mktemp($template);
109
110print "# MKTEMP: Tempfile is $template -> $tmpfile\n";
111
112# Okay if template no longer has XXXXX in
113
114
115ok( ($tmpfile !~ /XXXXX$/) );