This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make t/test_pl/tempfile.t produce more diagnostics
[perl5.git] / 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     my $common_mess = "skip $skip filenames to $to so that the next one will end with $next";
26     if( $last == $skip ){
27         if( $check eq $cmp ){
28             pass( $common_mess );
29         }else{
30             my($alpha) = $check =~ /\Atmp\d+([A-Z][A-Z]?)\Z/;
31             fail( $common_mess, "only skipped to $alpha" )
32         }
33     }else{
34         fail( $common_mess, "only skipped $last files" );
35     }
36 }
37
38 note("skipping the first filename because it is taken for use by _fresh_perl()");
39
40 is( tempfile(), "${prefix}B");
41 is( tempfile(), "${prefix}C");
42
43 skip_files(22,'Y','Z');
44
45 is( tempfile(), "${prefix}Z", 'Last single letter filename');
46 is( tempfile(), "${prefix}AA", 'First double letter filename');
47
48 skip_files(24,'AY','AZ');
49
50 is( tempfile(), "${prefix}AZ");
51 is( tempfile(), "${prefix}BA");
52
53 skip_files(26 * 24 + 24,'ZY','ZZ');
54
55 is( tempfile(), "${prefix}ZZ", 'Last available filename');
56 ok( !eval{tempfile()}, 'Should bail after Last available filename' );
57 my $err = "$@";
58 like( $err, qr{^Can't find temporary file name starting}, 'check error string' );
59
60 done_testing();