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