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