In perl.git, the branch smoke-me/sprout-maint-5.16 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8ea898b6a522bad956e0a3d171d6897c533104b2?hp=1fab8097422c9c5cc9be92cd5b4675b764b60545>
- Log ----------------------------------------------------------------- commit 8ea898b6a522bad956e0a3d171d6897c533104b2 Author: Father Chrysostomos <[email protected]> Date: Wed Jul 25 22:04:02 2012 -0700 Stop truncate(word) from falling back to file name In commit 5e0adc2d66, which was a bug fix, I made the mistake of checking the truth of the return value of gv_fetchsv, which is called when truncateâs argument is a bareword. This meant that truncate FOO, 0; would truncate the file named FOO if the glob happened to have been deleted. (cherry picked from commit 42409c4069deb2417b838a49810ecbce306a72b9) M pp_sys.c M t/io/fs.t commit c3c69474c887a37fa2436fda1553acb94b92c92e Author: Father Chrysostomos <[email protected]> Date: Thu Jul 12 17:35:37 2012 -0700 Fix *ISA = *glob_without_array I broke this in 5.14 with commit 6624142a. In trying to make *ISA = *Other::ISA work, I added logic to make @Other::ISAâs existing magic now point to *ISAâs stash. I skipped that logic if *Other::ISA did not contain an array. But in so doing, I inadvertently skipped the call to mro_isa_changed_in at the same time. (cherry picked from commit dfedf89255b7306231f87f711321b2a976aec65f) M sv.c M t/mro/basic.t ----------------------------------------------------------------------- Summary of changes: pod/perlhist.pod | 12 +++++++++--- pp_sys.c | 6 +++--- sv.c | 5 +++-- t/io/fs.t | 12 ++++++++++-- t/mro/basic.t | 12 +++++++++++- 5 files changed, 36 insertions(+), 11 deletions(-) diff --git a/pod/perlhist.pod b/pod/perlhist.pod index d28e838..c45087b 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -31,7 +31,8 @@ Michael Schwern, Rafael Garcia-Suarez, Nicholas Clark, Richard Clamp, Leon Brocard, Dave Mitchell, Jesse Vincent, Ricardo Signes, Steve Hay, Matt S Trout, David Golden, Florian Ragwitz, Tatsuhiko Miyagawa, Chris C<BinGOs> Williams, Zefram, Ãvar Arnfjörð Bjarmason, Stevan -Little, Dave Rolsky, Max Maischein, and Abigail. +Little, Dave Rolsky, Max Maischein, Abigail, Jesse Luehrs and Tony +Cook. =head2 PUMPKIN? @@ -47,7 +48,7 @@ potato) but none caught on. Then, Chip asked: Who has the patch pumpkin? -To explain: David Croy once told me once that at a previous job, +To explain: David Croy once told me that at a previous job, there was one tape drive and multiple systems that used it for backups. But instead of some high-tech exclusion software, they used a low-tech method to prevent multiple simultaneous backups: a stuffed pumpkin. @@ -478,7 +479,12 @@ the strings?). Ricardo 5.16.0-RC0 2012-May-10 Ricardo 5.16.0-RC1 2012-May-14 Ricardo 5.16.0-RC2 2012-May-15 - Ricardo 5.16.0 2012-May-20 + + Ricardo 5.16.0 2012-May-20 The 5.16 maintenance track + + Zefram 5.17.0 2012-May-26 The 5.17 development track + Jesse L 5.17.1 2012-Jun-20 + TonyC 5.17.2 2012-Jul-20 =head2 SELECTED RELEASE SIZES diff --git a/pp_sys.c b/pp_sys.c index 70a026b..f4e9d67 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2204,9 +2204,9 @@ PP(pp_truncate) GV *tmpgv; IO *io; - if ((tmpgv = PL_op->op_flags & OPf_SPECIAL - ? gv_fetchsv(sv, 0, SVt_PVIO) - : MAYBE_DEREF_GV(sv) )) { + if (PL_op->op_flags & OPf_SPECIAL + ? (tmpgv = gv_fetchsv(sv, 0, SVt_PVIO), 1) + : !!(tmpgv = MAYBE_DEREF_GV(sv)) ) { io = GvIO(tmpgv); if (!io) result = 0; diff --git a/sv.c b/sv.c index 3ac2fd8..08d8b96 100644 --- a/sv.c +++ b/sv.c @@ -3705,7 +3705,6 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype) /* The stash may have been detached from the symbol table, so check its name. */ && GvSTASH(dstr) && HvENAME(GvSTASH(dstr)) - && GvAV((const GV *)sstr) ) mro_changes = 2; else { @@ -3740,6 +3739,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype) } GvMULTI_on(dstr); if(mro_changes == 2) { + if (GvAV((const GV *)sstr)) { MAGIC *mg; SV * const sref = (SV *)GvAV((const GV *)dstr); if (SvSMAGICAL(sref) && (mg = mg_find(sref, PERL_MAGIC_isa))) { @@ -3751,7 +3751,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype) av_push((AV *)mg->mg_obj, SvREFCNT_inc_simple_NN(dstr)); } else sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0); - mro_isa_changed_in(GvSTASH(dstr)); + } + mro_isa_changed_in(GvSTASH(dstr)); } else if(mro_changes == 3) { HV * const stash = GvHV(dstr); diff --git a/t/io/fs.t b/t/io/fs.t index 1cdddec..26208c1 100644 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -46,7 +46,7 @@ $needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95()); my $skip_mode_checks = $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/; -plan tests => 51; +plan tests => 52; my $tmpdir = tempfile(); my $tmpdir1 = tempfile(); @@ -372,7 +372,7 @@ SKIP: { SKIP: { if ($^O eq 'vos') { - skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 5); + skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 6); } is(-s $tmpfile, 200, "fh resize to 200 working (filename check)"); @@ -407,6 +407,14 @@ SKIP: { is(-s $tmpfile, 100, "fh resize by IO slot working"); close FH; + + my $n = "for_fs_dot_t$$"; + open FH, ">$n" or die "open $n: $!"; + print FH "bloh blah bla\n"; + close FH or die "close $n: $!"; + eval "truncate $n, 0; 1" or die; + ok !-z $n, 'truncate(word) does not fall back to file name'; + unlink $n; } } diff --git a/t/mro/basic.t b/t/mro/basic.t index 9955b81..e1a4dbf 100644 --- a/t/mro/basic.t +++ b/t/mro/basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -BEGIN { require q(./test.pl); } plan(tests => 52); +BEGIN { require q(./test.pl); } plan(tests => 53); require mro; @@ -328,3 +328,13 @@ is(eval { MRO_N->testfunc() }, 123); undef %Thwit::; ok !Thrext->isa('Sile'), 'undef %package:: updates subclasses'; } + +{ + # Obliterating @ISA via glob assignment + # Broken in 5.14.0; fixed in 5.17.2 + @Gwythaint::ISA = "Fantastic::Creature"; + undef *This_glob_haD_better_not_exist; # paranoia; must have no array + *Gwythaint::ISA = *This_glob_haD_better_not_exist; + ok !Gwythaint->isa("Fantastic::Creature"), + 'obliterating @ISA via glob assignment'; +} -- Perl5 Master Repository
