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