In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/55b0687d8bc1aa7e911b5fd2678ea7e8dbe6f059?hp=8e88cfee26d866223a6b3bfffce6270271de00db>
- Log ----------------------------------------------------------------- commit 55b0687d8bc1aa7e911b5fd2678ea7e8dbe6f059 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:16:56 2010 -0600 Modified unlink_all in t/test.pl to return the count of unlinked files This will make it so that it can be a drop-in replacement for unlink M t/test.pl commit 96fedf7b439670394f9a08f3e777580fd85ef6cf Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:14:51 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/uni/write.t M t/uni/write.t commit a29d026106e1b071b8c63d99b7b6f5699e0ed9cf Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:14:30 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/run/switches.t M t/run/switches.t commit 2f23a5a10ee809d60522c032c380c9232eb265f4 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:14:12 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/re/qr.t M t/re/qr.t commit 5fd6a57810f7439389bf02856e9156c3525cf159 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:13:57 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/op/sysio.t M t/op/sysio.t commit c291be4e4b7fb37889d8d8cd3e85082e09c1a5c0 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:13:05 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/op/stat.t M t/op/stat.t commit ba2406ebdc2887b3e8d65685667caf5bd72ee6d0 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:12:31 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/op/magic.t M t/op/magic.t commit 4d44d44a1070263051e2e6349db1ced0b358ce44 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:11:52 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/op/goto.t M t/op/goto.t commit 15f2ab62764ef8f043a58b64905c314b1ba2024c Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:11:23 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/op/filetest.t M t/op/filetest.t commit ab679d05ccb1664a50b42213788efa5fe66bb433 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:11:00 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/lib/deprecate.t M t/lib/deprecate.t commit 03cfa418dd8a7f0efec23f3e69cd965b9a09b610 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:10:39 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/io/perlio.t M t/io/perlio.t commit 7eedb18966fc19abaf70987a09a5ed8320a7d52c Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:09:30 2010 -0600 Replaced 'unlink' with 'unlink_all' in t/io/nargv.t M t/io/nargv.t commit 9bf0f160d67aaad9cf4488cfd8ed95d6de39d121 Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:08:07 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/io/fs.t M t/io/fs.t commit 4813d64b92902e7306bfebf4c41e1d24b77aa33d Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 17:07:51 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/io/argv.t M t/io/argv.t commit 951af6b5343ac2be493fd6a9672c16f164ea2f7c Author: Brad Gilbert <[email protected]> Date: Tue Dec 7 16:17:02 2010 -0600 Replaced '1 while unlink' with 'unlink_all' in t/op/write.t M t/op/write.t commit 3aadd5cd55cb7dedef11ffce3eef74f924ccd1bb Author: Father Chrysostomos <[email protected]> Date: Wed Dec 8 11:11:07 2010 -0800 [perl #19135] string eval turns off readonlyness on lexicals Donât turn off readonliness on lexicals when freeing pad entries. The readonliness is (prior to this commit) turned off explicitly in pad_free under ithreads. See also bug #19022, which resulted from the same change. There is some discussion there, too, but nobody seemed to know exactly why the readonliness needed to be turned off. Change 4761/2aa1bed, from January of 2000, added that SvREADONLY_off. It is supposed to make sure that pad entries that were constants will not be constants the next time they are used. Dave Mitchell writes: > I think...[this]...fix is correct (just removing the SvREADONLY_off). > The issue it was trying to fix appears to have been properly fixed > later by 3b1c21fabed159100271bd60bac3f870f5ac16af, which is why it's > safe to remove it. So this commit just deletes that code. M pad.c M t/op/eval.t ----------------------------------------------------------------------- Summary of changes: pad.c | 5 ----- t/io/argv.t | 2 +- t/io/fs.t | 2 +- t/io/nargv.t | 2 +- t/io/perlio.t | 10 +++++----- t/lib/deprecate.t | 4 ++-- t/op/eval.t | 8 +++++++- t/op/filetest.t | 2 +- t/op/goto.t | 2 +- t/op/magic.t | 5 ++++- t/op/stat.t | 4 ++-- t/op/sysio.t | 4 ++-- t/op/write.t | 16 ++++++++-------- t/re/qr.t | 2 +- t/run/switches.t | 4 ++-- t/test.pl | 8 +++++++- t/uni/write.t | 2 +- 17 files changed, 46 insertions(+), 36 deletions(-) diff --git a/pad.c b/pad.c index 9b8cda5..8ab34ff 100644 --- a/pad.c +++ b/pad.c @@ -1450,11 +1450,6 @@ Perl_pad_free(pTHX_ PADOFFSET po) if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) { SvPADTMP_off(PL_curpad[po]); -#ifdef USE_ITHREADS - /* SV could be a shared hash key (eg bugid #19022) */ - if (!SvIsCOW(PL_curpad[po])) - SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */ -#endif } if ((I32)po < PL_padix) PL_padix = po - 1; diff --git a/t/io/argv.t b/t/io/argv.t index d6c895d..8356938 100644 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -137,6 +137,6 @@ unlink "Io_argv3.tmp"; **PROG** END { - 1 while unlink 'Io_argv1.tmp', 'Io_argv1.tmp_bak', + unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak', 'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp'; } diff --git a/t/io/fs.t b/t/io/fs.t index ee32f63..64fcc5b 100644 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -424,7 +424,7 @@ SKIP: { # this works on win32 only, because fs isn't casesensitive ok(-e 'X', "rename working"); - 1 while unlink 'X'; + unlink_all 'X'; chdir $wd || die "Can't cd back to $wd"; } diff --git a/t/io/nargv.t b/t/io/nargv.t index c5b84fc..41417cd 100644 --- a/t/io/nargv.t +++ b/t/io/nargv.t @@ -71,4 +71,4 @@ sub mkfiles { return wantarray ? @results : @results[-1]; } -END { unlink map { ($_, "$_.bak") } mkfiles(1..5) } +END { unlink_all map { ($_, "$_.bak") } mkfiles(1..5) } diff --git a/t/io/perlio.t b/t/io/perlio.t index b9f00a7..8b1cff3 100644 --- a/t/io/perlio.t +++ b/t/io/perlio.t @@ -105,14 +105,14 @@ ok(close($utffh)); my $filename = find_filename($x, $perlio_tmp_file_glob); is($filename, undef, "No tmp files leaked"); - unlink $filename if defined $filename; + unlink_all $filename if defined $filename; mkdir $ENV{TMPDIR}; ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir'); $filename = find_filename($x, $perlio_tmp_file_glob); is($filename, undef, "No tmp files leaked"); - unlink $filename if defined $filename; + unlink_all $filename if defined $filename; } } @@ -198,9 +198,9 @@ close ($no_perlio); END { - 1 while unlink $txt; - 1 while unlink $bin; - 1 while unlink $utf; + unlink_all $txt; + unlink_all $bin; + unlink_all $utf; rmdir $nonexistent; } diff --git a/t/lib/deprecate.t b/t/lib/deprecate.t index 92bb673..9e59469 100644 --- a/t/lib/deprecate.t +++ b/t/lib/deprecate.t @@ -57,7 +57,7 @@ for my $lib (sort keys %tests) { } delete $INC{$module}; - unlink $pm; + unlink_all $pm; } my $sub_dir = 'Optionally'; @@ -83,7 +83,7 @@ for my $lib (sort keys %tests) { } delete $INC{"$sub_dir/$module"}; - unlink $pm; + unlink_all $pm; } END { File::Path::remove_tree('lib') } diff --git a/t/op/eval.t b/t/op/eval.t index 0a5fadc..a1c1c1a 100644 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -print "1..107\n"; +print "1..108\n"; eval 'print "ok 1\n";'; @@ -611,3 +611,9 @@ eval $ov; print "ok\n"; EOP +for my $k (!0) { + eval 'my $do_something_with = $k'; + eval { $k = 'mon' }; + is "a" =~ /a/, "1", + "string eval leaves readonly lexicals readonly [perl #19135]"; +} diff --git a/t/op/filetest.t b/t/op/filetest.t index 4659c70..f562646 100644 --- a/t/op/filetest.t +++ b/t/op/filetest.t @@ -87,7 +87,7 @@ ok( -f $tempfile ); is( -s $tempfile, 0 ); is( -f -s $tempfile, 0 ); is( -s -f $tempfile, 0 ); -unlink $tempfile; +unlink_all $tempfile; # test that _ is a bareword after filetest operators diff --git a/t/op/goto.t b/t/op/goto.t index 12bade9..4de47ef 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -231,7 +231,7 @@ close $f; $r = runperl(prog => 'use Op_goto01; print qq[DONE\n]'); is($r, "OK\nDONE\n", "goto within use-d file"); -unlink "Op_goto01.pm"; +unlink_all "Op_goto01.pm"; # test for [perl #24108] $ok = 1; diff --git a/t/op/magic.t b/t/op/magic.t index f5f6205..4c7f70c 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -42,7 +42,7 @@ if ($Is_MSWin32) { like `set FOO`, qr/^(?:FOO=)?hi there$/; } elsif ($Is_VMS) { is `write sys\$output f\$trnlnm("FOO")`, "hi there\n"; } else { is `echo \$FOO`, "hi there\n"; } -unlink 'ajslkdfpqjsjfk'; +unlink_all 'ajslkdfpqjsjfk'; $! = 0; open(FOO,'ajslkdfpqjsjfk'); isnt($!, 0); @@ -264,6 +264,9 @@ EOF is $_, $s1; } ok unlink($script) or diag $!; + # CHECK + # Could this be replaced with: + # unlink_all($script); } # $], $^O, $^T diff --git a/t/op/stat.t b/t/op/stat.t index bc05112..8d1b9f2 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -46,7 +46,7 @@ my $tmpfile = tempfile(); my $tmpfile_link = tempfile(); chmod 0666, $tmpfile; -1 while unlink $tmpfile; +unlink_all $tmpfile; open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!"); close FOO; @@ -551,5 +551,5 @@ SKIP: { END { chmod 0666, $tmpfile; - 1 while unlink $tmpfile; + unlink_all $tmpfile; } diff --git a/t/op/sysio.t b/t/op/sysio.t index d0f71ae..ba739f2 100644 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -209,7 +209,7 @@ ok(not defined sysseek(I, -1, 1)); close(I); -unlink $outfile; +unlink_all $outfile; # Check that utf8 IO doesn't upgrade the scalar open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!"; @@ -232,7 +232,7 @@ eval {syswrite I, 2;}; is($@, ''); close(I); -unlink $outfile; +unlink_all $outfile; chdir('..'); diff --git a/t/op/write.t b/t/op/write.t index 4038f43..b5c2210 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -95,7 +95,7 @@ now @<<the@>>>> for all@|||||men to come @<<<< . open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp"; -END { 1 while unlink 'Op_write.tmp' } +END { unlink_all 'Op_write.tmp' } $fox = 'foxiness'; $good = 'good'; @@ -115,7 +115,7 @@ the course of huma... now is the time for all good men to come to\n"; -is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp'; }; +is cat('Op_write.tmp'), $right and unlink_all 'Op_write.tmp'; $fox = 'wolfishness'; my $fox = 'foxiness'; # Test a lexical variable. @@ -154,7 +154,7 @@ becomes necessary now is the time for all good men to come to\n"; -is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp'; }; +is cat('Op_write.tmp'), $right and unlink_all 'Op_write.tmp'; eval <<'EOFORMAT'; format OUT2 = @@ -195,7 +195,7 @@ becomes necessary now is the time for all good men to come to\n"; -is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' }; +is cat('Op_write.tmp'), $right and unlink_all 'Op_write.tmp'; # formline tests @@ -248,7 +248,7 @@ close OUT3 or die "Could not close: $!"; $right = "fit\n"; -is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' }; +is cat('Op_write.tmp'), $right and unlink_all 'Op_write.tmp'; # test lexicals and globals @@ -276,7 +276,7 @@ format OUT4 = open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp"; write (OUT4); close OUT4 or die "Could not close: $!"; -is cat('Op_write.tmp'), "1\n" and do { 1 while unlink "Op_write.tmp" }; +is cat('Op_write.tmp'), "1\n" and unlink_all "Op_write.tmp"; eval <<'EOFORMAT'; format OUT10 = @@ -293,7 +293,7 @@ write(OUT10); close OUT10 or die "Could not close: $!"; $right = " 12.95 00012.95\n"; -is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' }; +is cat('Op_write.tmp'), $right and unlink_all 'Op_write.tmp'; eval <<'EOFORMAT'; format OUT11 = @@ -316,7 +316,7 @@ $right = "00012.95 1 0# 10 #\n"; -is cat('Op_write.tmp'), $right and do { 1 while unlink 'Op_write.tmp' }; +is cat('Op_write.tmp'), $right and unlink_all 'Op_write.tmp'; { my $test = curr_test(); diff --git a/t/re/qr.t b/t/re/qr.t index 7a7ca6a..fa5135f 100644 --- a/t/re/qr.t +++ b/t/re/qr.t @@ -121,7 +121,7 @@ EOTEST close $fh; my $out = runperl(stderr => 1, progfile => $prog); - unlink $prog; + unlink_all $prog; my $expected = <<'EOOUT'; ok 1 - weak copy equals original diff --git a/t/run/switches.t b/t/run/switches.t index ada6eaf..f636cea 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -22,7 +22,7 @@ $TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS'; my $r; my @tmpfiles = (); -END { unlink @tmpfiles } +END { unlink_all @tmpfiles } # Tests for -0 @@ -304,7 +304,7 @@ foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_") { local $TODO = ''; # these ones should work on VMS - sub do_i_unlink { 1 while unlink("file", "file.bak") } + sub do_i_unlink { unlink_all("file", "file.bak") } open(FILE, ">file") or die "$0: Failed to create 'file': $!"; print FILE <<__EOF__; diff --git a/t/test.pl b/t/test.pl index bfda110..a558820 100644 --- a/t/test.pl +++ b/t/test.pl @@ -630,10 +630,16 @@ sub which_perl { } sub unlink_all { + my $count = 0; foreach my $file (@_) { 1 while unlink $file; - _print_stderr "# Couldn't unlink '$file': $!\n" if -f $file; + if( -f $file ){ + _print_stderr "# Couldn't unlink '$file': $!\n"; + }else{ + ++$count; + } } + $count; } my %tmpfiles; diff --git a/t/uni/write.t b/t/uni/write.t index 0d5cedc..136be67 100644 --- a/t/uni/write.t +++ b/t/uni/write.t @@ -101,4 +101,4 @@ $ulite1 $bmulti$blite2 EOEXPECT -1 while unlink 'Uni_write.tmp'; +unlink_all 'Uni_write.tmp'; -- Perl5 Master Repository
