t/test_pl/tempfile.t

   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{
  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
  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
  47 skip_files(22,'Y','Z');
  48
  49 is( tempfile(), "${prefix}Z", 'Last single letter filename');
  50 is( tempfile(), "${prefix}AA", 'First double letter filename');
  51
  52 skip_files(24,'AY','AZ');
  53
  54 is( tempfile(), "${prefix}AZ");
  55 is( tempfile(), "${prefix}BA");
  56
  57 skip_files(26 * 24 + 24,'ZY','ZZ');
  58
  59 is( tempfile(), "${prefix}ZZ", 'Last available filename');
  60 ok( !eval{tempfile()}, 'Should bail after Last available filename' );
  61 my $err = "$@";
  62 like( $err, qr{^Can't find temporary file name starting}, 'check error string' );
  63
  64 done_testing();