summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2023-03-16 13:00:49 +0100
committerYves Orton <demerphq@gmail.com>2023-03-17 03:01:30 +0800
commit938df7bd54133016aa8627c69d8380a1742b25da (patch)
tree4a550e20bb391db673a75e4268ff91d9ee6832a1 /t
parent801c406dcd5a9fb54b1bd7963e65cce5ca0abfde (diff)
downloadperl-938df7bd54133016aa8627c69d8380a1742b25da.tar.gz
test_pl tests - we have not been testing test.pl for some time, fix tests
Somewhere along the way we stopped testing test.pl itself. This fixes that oversight, and repairs the tests to accomodate some of the changes that should have been noticed. This includes hardening the tests for Win32, which does not allow unlinking a file that is open.
Diffstat (limited to 't')
-rw-r--r--t/test.pl7
-rw-r--r--t/test_pl/can_isa_ok.t6
-rw-r--r--t/test_pl/plan_skip_all.t6
-rw-r--r--t/test_pl/tempfile.t24
4 files changed, 32 insertions, 11 deletions
diff --git a/t/test.pl b/t/test.pl
index c4a0cf7720..7df78c7b62 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -1001,8 +1001,8 @@ sub _num_to_alpha {
$max_char = 0 if !defined($max_char) or $max_char < 0;
while( 1 ){
- $alpha = $letters[ $num % 26 ] . $alpha;
- $num = int( $num / 26 );
+ $alpha = $letters[ $num % @letters ] . $alpha;
+ $num = int( $num / @letters );
last if $num == 0;
$num = $num - 1;
@@ -1033,6 +1033,9 @@ $::tempfile_regexp = 'tmp_[A-Z]+_[A-Z]+';
# Avoid ++, avoid ranges, avoid split //
my $tempfile_count = 0;
my $max_file_chars = 3;
+# Note that the max number of is NOT 26**3, it is 26**3 + 26**2 + 26,
+# as 3 character files are distinct from 2 character files, from 1 characters
+# files, etc.
sub tempfile {
# if you change the format returned by tempfile() you MUST change
# the $::tempfile_regex define above.
diff --git a/t/test_pl/can_isa_ok.t b/t/test_pl/can_isa_ok.t
index 081d3e563b..5e18ba94d8 100644
--- a/t/test_pl/can_isa_ok.t
+++ b/t/test_pl/can_isa_ok.t
@@ -5,7 +5,11 @@
use strict;
use warnings;
-BEGIN { require "test.pl"; }
+BEGIN {
+ chdir 't' if -d 't';
+ push @INC, ".";
+ require 'test.pl';
+}
require Test::More;
diff --git a/t/test_pl/plan_skip_all.t b/t/test_pl/plan_skip_all.t
index fddb8f0c66..66c39eb901 100644
--- a/t/test_pl/plan_skip_all.t
+++ b/t/test_pl/plan_skip_all.t
@@ -2,6 +2,10 @@
use strict;
use warnings;
-BEGIN { require "test.pl"; }
+BEGIN {
+ chdir 't' if -d 't';
+ push @INC, ".";
+ require 'test.pl';
+}
plan skip_all => "Test Test::More compatible plan skip_all => \$foo";
diff --git a/t/test_pl/tempfile.t b/t/test_pl/tempfile.t
index d507d60642..f35738bfae 100644
--- a/t/test_pl/tempfile.t
+++ b/t/test_pl/tempfile.t
@@ -2,11 +2,14 @@
BEGIN {
chdir 't' if -d 't';
- require './test.pl';
+ push @INC, ".";
+ push @INC, "../lib";
+ require 'test.pl';
}
+
use strict;
-my $prefix = 'tmp'.$$;
+my $prefix = 'tmp_'._num_to_alpha($$)."_";
sub skip_files{
my($skip,$to,$next) = @_;
@@ -29,7 +32,7 @@ sub skip_files{
if( $check eq $cmp ){
pass( $common_mess );
}else{
- my($alpha) = $check =~ /\Atmp\d+([A-Z][A-Z]?)\Z/;
+ my($alpha) = $check =~ /\Atmp_[A-Z]+_([A-Z]+)\Z/;
fail( $common_mess );
diag( "only skipped to $alpha" );
}
@@ -68,12 +71,15 @@ skip_files(24,'AY','AZ');
is( tempfile(), "${prefix}AZ");
is( tempfile(), "${prefix}BA");
-skip_files(26 * 24 + 24,'ZY','ZZ');
+# note that 3 character suffixes are distinct from 2 character suffixes,
+# which are distinct from 1 character suffixes. Thus 18278 files max for
+# a 3 character suffix max.
+skip_files((26 * 26 * 26) + (26*24 + 24) ,'ZZY','ZZZ');
-is( tempfile(), "${prefix}ZZ", 'Last available filename');
+is( tempfile(), "${prefix}ZZZ", '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' );
+like( $err, qr{^panic: Too many tempfile\(\)s}, 'check error string' );
{
my $returned = runperl( progs => [
@@ -82,11 +88,15 @@ like( $err, qr{^Can't find temporary file name starting}, 'check error string' )
'print qq[$t|];',
'print open(FH,q[>],$t) ? qq[ok|] : qq[not ok|] ;',
'print -e $t ? qq[ok|] : qq[not ok|];',
+ 'print close(FH) ? qq[ok] : qq[not ok];', # see comment below
] );
- my($filename,$opened,$existed) = split /\|/, $returned;
+ # NOTE, on Win32 we cannot unlink an open file, so we MUST
+ # close the file before the program exits.
+ my($filename,$opened,$existed,$closed) = split /\|/, $returned;
is( $opened, 'ok', "$filename created" );
is( $existed, 'ok', "$filename did exist" );
+ is( $closed, 'ok', "$filename was closed" );
ok( !-e $filename, "$filename doesn't exist now" );
}