In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/736be88fdd627ea774a29942bde021e39c4e7d8e?hp=1795f87385d4c3168e3220efd0d169635104f863>
- Log ----------------------------------------------------------------- commit 736be88fdd627ea774a29942bde021e39c4e7d8e Author: Father Chrysostomos <[email protected]> Date: Tue Sep 25 14:16:13 2012 -0700 Add t/test_pl* to MANIFEST Soon, weâll be testing that these tests work. :-) M MANIFEST commit 856b2dd2bfc175ae9c3e539b0e325390a24a1d6d Author: Brad Gilbert <[email protected]> Date: Tue Sep 25 13:12:54 2012 -0500 Make t/test_pl/tempfile.t produce more diagnostics M t/test_pl/tempfile.t commit ca3b95856a20c1076fe7a1239379b44400faeed6 Author: Brad Gilbert <[email protected]> Date: Sun Sep 16 15:28:01 2012 -0500 Added t/test_pl/tempfile.t A t/test_pl/tempfile.t commit 7b29226f59fa6ba0679496494a3cc111aa82a513 Author: Brad Gilbert <[email protected]> Date: Sun Sep 16 15:23:36 2012 -0500 Rework tempfile() in t/test.pl to use _num_to_alpha() M t/test.pl commit a087e8153f95d3e52d52a6d8ce91cd2f671e4649 Author: Brad Gilbert <[email protected]> Date: Sun Sep 16 15:15:02 2012 -0500 Added test names to some tests in t/test_pl/_num_to_alpha.t M t/test_pl/_num_to_alpha.t commit 2c36667f7c4d91271f1c87c4e26d12a655e55ff5 Author: Brad Gilbert <[email protected]> Date: Sun Sep 16 14:25:19 2012 -0500 Added optional char limit to _num_to_alpha() in test.pl M t/test.pl M t/test_pl/_num_to_alpha.t commit f6e25e605fbd478eb79575b48accf888d57494e5 Author: Brad Gilbert <[email protected]> Date: Sun Sep 16 14:06:59 2012 -0500 Add _num_to_alpha() to test.pl Also added testing for _num_to_alpha() M t/test.pl A t/test_pl/_num_to_alpha.t commit 48e9c5d48f9e8a882c41665cd4c18fb237fc00ac Author: Brad Gilbert <[email protected]> Date: Tue Sep 25 11:39:45 2012 -0500 Move @letters in test.pl earlier M t/test.pl ----------------------------------------------------------------------- Summary of changes: MANIFEST | 2 + t/test.pl | 58 +++++++++++++++++++++++++++++++++++-------- t/test_pl/_num_to_alpha.t | 44 +++++++++++++++++++++++++++++++++ t/test_pl/tempfile.t | 60 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 153 insertions(+), 11 deletions(-) create mode 100644 t/test_pl/_num_to_alpha.t create mode 100644 t/test_pl/tempfile.t diff --git a/MANIFEST b/MANIFEST index 93ce636..a3e752b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5507,6 +5507,8 @@ t/run/switchx.t Test the -x switch t/TEST The regression tester t/test.pl Simple testing library t/test_pl/can_isa_ok.t Tests for the simple testing library +t/test_pl/_num_to_alpha.t Tests for the simple testing library +t/test_pl/tempfile.t Tests for the simple testing library t/thread_it.pl Run regression tests in a new thread t/uni/attrs.t See if Unicode attributes work t/uni/bless.t See if Unicode bless works diff --git a/t/test.pl b/t/test.pl index 44a38dc..bf9269b 100644 --- a/t/test.pl +++ b/t/test.pl @@ -762,6 +762,44 @@ sub unlink_all { $count; } +# _num_to_alpha - Returns a string of letters representing a positive integer. +# Arguments : +# number to convert +# maximum number of letters + +# returns undef if the number is negative +# returns undef if the number of letters is greater than the maximum wanted + +# _num_to_alpha( 0) eq 'A'; +# _num_to_alpha( 1) eq 'B'; +# _num_to_alpha(25) eq 'Z'; +# _num_to_alpha(26) eq 'AA'; +# _num_to_alpha(27) eq 'AB'; + +my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z); + +# Avoid ++ -- ranges split negative numbers +sub _num_to_alpha{ + my($num,$max_char) = @_; + return unless $num >= 0; + my $alpha = ''; + my $char_count = 0; + $max_char = 0 if $max_char < 0; + + while( 1 ){ + $alpha = $letters[ $num % 26 ] . $alpha; + $num = int( $num / 26 ); + last if $num == 0; + $num = $num - 1; + + # char limit + next unless $max_char; + $char_count = $char_count + 1; + return if $char_count == $max_char; + } + return $alpha; +} + my %tmpfiles; END { unlink_all keys %tmpfiles } @@ -769,25 +807,23 @@ END { unlink_all keys %tmpfiles } $::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?'; # Avoid ++, avoid ranges, avoid split // -my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z); +my $tempfile_count = 0; sub tempfile { - my $count = 0; - do { - my $temp = $count; + while(1){ my $try = "tmp$$"; - do { - $try = $try . $letters[$temp % 26]; - $temp = int ($temp / 26); - } while $temp; + my $alpha = _num_to_alpha($tempfile_count,2); + last unless defined $alpha; + $try = $try . $alpha; + $tempfile_count = $tempfile_count + 1; + # Need to note all the file names we allocated, as a second request may # come before the first is created. - if (!-e $try && !$tmpfiles{$try}) { + if (!$tmpfiles{$try} && !-e $try) { # We have a winner $tmpfiles{$try} = 1; return $try; } - $count = $count + 1; - } while $count < 26 * 26; + } die "Can't find temporary file name starting 'tmp$$'"; } diff --git a/t/test_pl/_num_to_alpha.t b/t/test_pl/_num_to_alpha.t new file mode 100644 index 0000000..01aed33 --- /dev/null +++ b/t/test_pl/_num_to_alpha.t @@ -0,0 +1,44 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; +} + +is( _num_to_alpha(-1), undef, 'Returns undef for negative numbers'); +is( _num_to_alpha( 0), 'A', "Starts at 'A'"); +is( _num_to_alpha( 1), 'B'); + +is( _num_to_alpha(26 - 1), 'Z', 'Last single letter return value'); +is( _num_to_alpha(26 ), 'AA', 'First double letter return value'); +is( _num_to_alpha(26 + 1), 'AB'); + +is( _num_to_alpha(26 + 26 - 2), 'AY'); +is( _num_to_alpha(26 + 26 - 1), 'AZ'); +is( _num_to_alpha(26 + 26 ), 'BA'); +is( _num_to_alpha(26 + 26 + 1), 'BB'); + +is( _num_to_alpha(26 ** 2 - 1), 'YZ'); +is( _num_to_alpha(26 ** 2 ), 'ZA'); +is( _num_to_alpha(26 ** 2 + 1), 'ZB'); + +is( _num_to_alpha(26 ** 2 + 26 - 1), 'ZZ', 'Last double letter return value'); +is( _num_to_alpha(26 ** 2 + 26 ), 'AAA', 'First triple letter return value'); +is( _num_to_alpha(26 ** 2 + 26 + 1), 'AAB'); + +is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 - 1 ), 'ZZZ', 'Last triple letter return value'); +is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 ), 'AAAA', 'First quadruple letter return value'); +is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 + 1 ), 'AAAB'); + +note('Testing limit capabilities'); + +is( _num_to_alpha(26 - 1 , 1), 'Z', 'Largest return value for one letter'); +is( _num_to_alpha(26 , 1), undef); # AA + +is( _num_to_alpha(26 ** 2 + 26 - 1 , 2 ), 'ZZ', 'Largest return value for two letters'); +is( _num_to_alpha(26 ** 2 + 26 , 2 ), undef); # AAA + +is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 - 1 , 3 ), 'ZZZ', 'Largest return value for three letters'); +is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 , 3 ), undef); # AAAA + +done_testing(); diff --git a/t/test_pl/tempfile.t b/t/test_pl/tempfile.t new file mode 100644 index 0000000..51937c4 --- /dev/null +++ b/t/test_pl/tempfile.t @@ -0,0 +1,60 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; +} +use strict; + +my $prefix = 'tmp'.$$; + +sub skip_files{ + my($skip,$to,$next) = @_; + my($last,$check); + my $cmp = $prefix . $to; + + for( 1..$skip ){ + $check = tempfile(); + $last = $_; + if( $check eq $cmp && $_ != $skip ){ + # let the next test pass + last; + } + } + + my $common_mess = "skip $skip filenames to $to so that the next one will end with $next"; + if( $last == $skip ){ + if( $check eq $cmp ){ + pass( $common_mess ); + }else{ + my($alpha) = $check =~ /\Atmp\d+([A-Z][A-Z]?)\Z/; + fail( $common_mess, "only skipped to $alpha" ) + } + }else{ + fail( $common_mess, "only skipped $last files" ); + } +} + +note("skipping the first filename because it is taken for use by _fresh_perl()"); + +is( tempfile(), "${prefix}B"); +is( tempfile(), "${prefix}C"); + +skip_files(22,'Y','Z'); + +is( tempfile(), "${prefix}Z", 'Last single letter filename'); +is( tempfile(), "${prefix}AA", 'First double letter filename'); + +skip_files(24,'AY','AZ'); + +is( tempfile(), "${prefix}AZ"); +is( tempfile(), "${prefix}BA"); + +skip_files(26 * 24 + 24,'ZY','ZZ'); + +is( tempfile(), "${prefix}ZZ", 'Last available filename'); +ok( !eval{tempfile()}, 'Should bail after Last available filename' ); +my $err = "$@"; +like( $err, qr{^Can't find temporary file name starting}, 'check error string' ); + +done_testing(); -- Perl5 Master Repository
