tempfile.t revision 1.1.1.3 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    push @INC, ".";
6    push @INC, "../lib";
7    require 'test.pl';
8}
9
10use strict;
11
12my $prefix = 'tmp_'._num_to_alpha($$)."_";
13
14sub skip_files{
15    my($skip,$to,$next) = @_;
16    my($last,$check);
17    my $cmp = $prefix . $to;
18
19    for( 1..$skip ){
20        $check = tempfile();
21        $last = $_;
22        if( $check eq $cmp && $_ != $skip ){
23            # let the next test pass
24            last;
25        }
26    }
27
28    local $main::Level = $main::Level + 1;
29
30    my $common_mess = "skip $skip filenames to $to so that the next one will end with $next";
31    if( $last == $skip ){
32        if( $check eq $cmp ){
33            pass( $common_mess );
34        }else{
35            my($alpha) = $check =~ /\Atmp_[A-Z]+_([A-Z]+)\Z/;
36            fail( $common_mess );
37            diag( "only skipped to $alpha" );
38        }
39    }else{
40        fail( $common_mess );
41        diag( "only skipped $last out of $skip files" );
42    }
43}
44
45note("skipping the first filename because it is taken for use by _fresh_perl()");
46
47is( tempfile(), "${prefix}B");
48is( tempfile(), "${prefix}C");
49
50{
51    ok( open( my $fh, '>', "${prefix}D" ), 'created file with the next filename' );
52    is( tempfile(), "${prefix}E", 'properly skips files that already exist');
53
54    if( close($fh) ){
55        unlink_all("${prefix}D");
56    }else{
57        tempfile(); # allow the rest of the tests to work correctly
58    }
59}
60
61ok( register_tempfile("${prefix}F"), 'registered the next file with register_tempfile' );
62is( tempfile(), "${prefix}G", 'tempfile() properly skips files added with register_tempfile()' );
63
64skip_files(18,'Y','Z');
65
66is( tempfile(), "${prefix}Z", 'Last single letter filename');
67is( tempfile(), "${prefix}AA", 'First double letter filename');
68
69skip_files(24,'AY','AZ');
70
71is( tempfile(), "${prefix}AZ");
72is( tempfile(), "${prefix}BA");
73
74# note that 3 character suffixes are distinct from 2 character suffixes,
75# which are distinct from 1 character suffixes. Thus 18278 files max for
76# a 3 character suffix max.
77skip_files((26 * 26 * 26) + (26*24 + 24) ,'ZZY','ZZZ');
78
79is( tempfile(), "${prefix}ZZZ", 'Last available filename');
80ok( !eval{tempfile()}, 'Should bail after Last available filename' );
81my $err = "$@";
82like( $err, qr{^panic: Too many tempfile\(\)s}, 'check error string' );
83
84{
85    my $returned = runperl( progs => [
86        'require q[./test.pl];',
87        'my $t = tempfile();',
88        'print qq[$t|];',
89        'print open(FH,q[>],$t) ? qq[ok|] : qq[not ok|] ;',
90        'print -e $t ? qq[ok|] : qq[not ok|];',
91        'print close(FH) ? qq[ok] : qq[not ok];', # see comment below
92    ] );
93    # NOTE, on Win32 we cannot unlink an open file, so we MUST
94    # close the file before the program exits.
95    my($filename,$opened,$existed,$closed) = split /\|/, $returned;
96
97    is( $opened, 'ok', "$filename created" );
98    is( $existed, 'ok', "$filename did exist" );
99    is( $closed, 'ok', "$filename was closed" );
100    ok( !-e $filename, "$filename doesn't exist now" );
101}
102
103done_testing();
104