Commit | Line | Data |
---|---|---|
ca3b9585 BG |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | require './test.pl'; | |
6 | } | |
7 | use strict; | |
8 | ||
9 | my $prefix = 'tmp'.$$; | |
10 | ||
11 | sub skip_files{ | |
856b2dd2 BG |
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 | ||
2691f8f5 BG |
25 | local $main::Level = $main::Level + 1; |
26 | ||
856b2dd2 BG |
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/; | |
2691f8f5 BG |
33 | fail( $common_mess ); |
34 | diag( "only skipped to $alpha" ); | |
856b2dd2 BG |
35 | } |
36 | }else{ | |
2691f8f5 BG |
37 | fail( $common_mess ); |
38 | diag( "only skipped $last out of $skip files" ); | |
856b2dd2 | 39 | } |
ca3b9585 BG |
40 | } |
41 | ||
42 | note("skipping the first filename because it is taken for use by _fresh_perl()"); | |
43 | ||
44 | is( tempfile(), "${prefix}B"); | |
45 | is( tempfile(), "${prefix}C"); | |
46 | ||
7c3b91c9 BG |
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 | ||
5eccd97a BG |
58 | ok( register_tempfile("${prefix}F"), 'registered the next file with register_tempfile' ); |
59 | is( tempfile(), "${prefix}G", 'tempfile() properly skips files added with register_tempfile()' ); | |
60 | ||
61 | skip_files(18,'Y','Z'); | |
ca3b9585 BG |
62 | |
63 | is( tempfile(), "${prefix}Z", 'Last single letter filename'); | |
64 | is( tempfile(), "${prefix}AA", 'First double letter filename'); | |
65 | ||
856b2dd2 | 66 | skip_files(24,'AY','AZ'); |
ca3b9585 BG |
67 | |
68 | is( tempfile(), "${prefix}AZ"); | |
69 | is( tempfile(), "${prefix}BA"); | |
70 | ||
856b2dd2 | 71 | skip_files(26 * 24 + 24,'ZY','ZZ'); |
ca3b9585 BG |
72 | |
73 | is( tempfile(), "${prefix}ZZ", 'Last available filename'); | |
74 | ok( !eval{tempfile()}, 'Should bail after Last available filename' ); | |
75 | my $err = "$@"; | |
76 | like( $err, qr{^Can't find temporary file name starting}, 'check error string' ); | |
77 | ||
19e06093 BG |
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 | ||
ca3b9585 | 93 | done_testing(); |