#!./perl BEGIN { chdir 't' if -d 't'; require "./test.pl"; set_up_inc('../lib'); } print "1..7\n"; my $j = 1; for $i ( 1,2,5,4,3 ) { $file = mkfiles($i); open(FH, "> $file") || die "can't create $file: $!"; print FH "not ok " . $j++ . "\n"; close(FH) || die "Can't close $file: $!"; } { local *ARGV; local $^I = '.bak'; local $_; @ARGV = mkfiles(1..3); $n = 0; while (<>) { print STDOUT "# initial \@ARGV: [@ARGV]\n"; if ($n++ == 2) { other(); } show(); } } $^I = undef; @ARGV = mkfiles(1..3); $n = 0; while (<>) { print STDOUT "#final \@ARGV: [@ARGV]\n"; if ($n++ == 2) { other(); } show(); } # test setuid is preserved (and hopefully setgid) # # With nested in-place editing PL_oldname and PL_filemode would # be overwritten by the values for the last file in the nested # loop. This is now all stored as magic in *ARGVOUT{IO} $^I = ""; @ARGV = mkfiles(1..3); my $sidfile = $ARGV[1]; chmod(04600, $sidfile); my $mode = (stat $ARGV[1])[2]; $n = 0; while (<>) { print STDOUT "#final \@ARGV: [@ARGV]\n"; if ($n++ == 1) { other(); } print; } my $newmode = (stat $sidfile)[2]; printf "# before %#o after %#o\n", $mode, $newmode; print +($mode == $newmode ? "" : "not "). "ok 6 # check setuid mode preserved\n"; sub show { #warn "$ARGV: $_"; s/^not //; print; } sub other { no warnings 'once'; print STDOUT "# Calling other\n"; local *ARGV; local *ARGVOUT; local $_; @ARGV = mkfiles(5, 4); while (<>) { print STDOUT "# inner \@ARGV: [@ARGV]\n"; show(); } } { # (perl #133314) directory handle leak # # We process a significant number of files here to make sure any # leaks are significant @ARGV = mkfiles(1 .. 10); for my $file (@ARGV) { open my $f, ">", $file; print $f "\n"; close $f; } local $^I = ".bak"; local $_; while (<>) { s/^/foo/; } } { # (perl #133314) directory handle leak # We open three handles here because the file processing opened: # - the original file # - the output file, and finally # - the directory # so we need to open the first two to use up the slots used for the original # and output files. # This test assumes fd are allocated in the typical *nix way - lowest # available, which I believe is the case for the Win32 CRTs too. # If this turns out not to be the case this test will need to skip on # such platforms or only run on a small set of known-good platforms. my $tfile = mkfiles(1); open my $f, "<", $tfile or die "Cannot open temp: $!"; open my $f2, "<", $tfile or die "Cannot open temp: $!"; open my $f3, "<", $tfile or die "Cannot open temp: $!"; print +(fileno($f3) < 20 ? "ok" : "not ok"), " 7 check fd leak\n"; close $f; close $f2; close $f3; } my @files; sub mkfiles { foreach (@_) { $files[$_] ||= tempfile(); } my @results = @files[@_]; return wantarray ? @results : @results[-1]; } END { unlink_all map { ($_, "$_.bak") } @files }