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
authorBrad Gilbert <b2gills@gmail.com>
Tue, 25 Sep 2012 18:12:54 +0000 (13:12 -0500)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 25 Sep 2012 21:35:13 +0000 (14:35 -0700)
t/test_pl/tempfile.t

index f384ba8..51937c4 100644 (file)
@@ -9,9 +9,30 @@ use strict;
 my $prefix = 'tmp'.$$;
 
 sub skip_files{
-  my($skip,$to) = @_;
-  note("skipping $skip filenames so that the next one will end with $to.");
-  tempfile() for 1..$skip;
+    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()");
@@ -19,17 +40,17 @@ 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,'Z');
+skip_files(22,'Y','Z');
 
 is( tempfile(), "${prefix}Z", 'Last single letter filename');
 is( tempfile(), "${prefix}AA", 'First double letter filename');
 
-skip_files(24,'AZ');
+skip_files(24,'AY','AZ');
 
 is( tempfile(), "${prefix}AZ");
 is( tempfile(), "${prefix}BA");
 
-skip_files(26 * 24 + 24,'ZZ');
+skip_files(26 * 24 + 24,'ZY','ZZ');
 
 is( tempfile(), "${prefix}ZZ", 'Last available filename');
 ok( !eval{tempfile()}, 'Should bail after Last available filename' );