This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta - move split change to other perlfunc changes and add issue link
[perl5.git] / t / test_pl / tempfile.t
index f384ba8..d507d60 100644 (file)
@@ -9,9 +9,34 @@ 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;
+        }
+    }
+
+    local $main::Level = $main::Level + 1;
+
+    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 );
+            diag( "only skipped to $alpha" );
+        }
+    }else{
+        fail( $common_mess );
+        diag( "only skipped $last out of $skip files" );
+    }
 }
 
 note("skipping the first filename because it is taken for use by _fresh_perl()");
@@ -19,21 +44,50 @@ 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');
+{
+    ok( open( my $fh, '>', "${prefix}D" ), 'created file with the next filename' );
+    is( tempfile(), "${prefix}E", 'properly skips files that already exist');
+
+    if( close($fh) ){
+        unlink_all("${prefix}D");
+    }else{
+        tempfile(); # allow the rest of the tests to work correctly
+    }
+}
+
+ok( register_tempfile("${prefix}F"), 'registered the next file with register_tempfile' );
+is( tempfile(), "${prefix}G", 'tempfile() properly skips files added with register_tempfile()' );
+
+skip_files(18,'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' );
 my $err = "$@";
 like( $err, qr{^Can't find temporary file name starting}, 'check error string' );
 
+{
+    my $returned = runperl( progs => [
+        'require q[./test.pl];',
+        'my $t = tempfile();',
+        'print qq[$t|];',
+        'print open(FH,q[>],$t) ? qq[ok|] : qq[not ok|] ;',
+        'print -e $t ? qq[ok|] : qq[not ok|];',
+    ] );
+    my($filename,$opened,$existed) = split /\|/, $returned;
+
+    is( $opened, 'ok', "$filename created" );
+    is( $existed, 'ok', "$filename did exist" );
+    ok( !-e $filename, "$filename doesn't exist now" );
+}
+
 done_testing();