Change 30701 by [EMAIL PROTECTED] on 2007/03/22 22:25:21 Integrate: [ 29359] More safety in free()s [ 30389] Subject: [PATCH] perlio.c (PerlIO_tmpfile): fix memory leak From: Alexey Tourbin <[EMAIL PROTECTED]> Date: Sat, 24 Feb 2007 14:47:35 +0300 Message-ID: <[EMAIL PROTECTED]> [ 30398] Subject: [perl #41560] [PATCH] crash in Perl_vmess when GvIOp is null From: "Devin Heitmueller" (via RT) <[EMAIL PROTECTED]> Date: Tue, 20 Feb 2007 16:38:20 -0800 Message-ID: <[EMAIL PROTECTED]> [ 30442] Don't crash if the symbol table entry for ISA isn't a typeglob. [ 30443] More assertion failures, found by auditing the code. [ 30448] Add a volatile modifier to avoid possible cloberring by longjmp, as the compiler used by Jerry D. Hedden warns. [ 30452] As the test is about the parser, not actually running the code, better to avoid running <STDOUT> rather than run it with warnings disabled. [ 30513] Need to extend the stack when using warn() without an argument (this fixes bug #41716) [ 30560] Need a SPAGAIN here because the stack pointer might have moved when evaluating a tied hash in scalar context. [ 30577] use a fresh stack when loading Errno.pm etc. Stops 'use vars qw($!)' in lib/vars.t segfaulting. (This can be reduced to 'my $sym = "!"; *$sym = \$$sym')
Affected files ... ... //depot/maint-5.8/perl/gv.c#104 integrate ... //depot/maint-5.8/perl/op.c#208 integrate ... //depot/maint-5.8/perl/perl.c#208 integrate ... //depot/maint-5.8/perl/perlio.c#110 integrate ... //depot/maint-5.8/perl/pp_hot.c#136 integrate ... //depot/maint-5.8/perl/pp_sys.c#146 integrate ... //depot/maint-5.8/perl/t/op/gv.t#9 integrate ... //depot/maint-5.8/perl/toke.c#170 integrate ... //depot/maint-5.8/perl/universal.c#65 integrate ... //depot/maint-5.8/perl/util.c#148 integrate Differences ... ==== //depot/maint-5.8/perl/gv.c#104 (text) ==== Index: perl/gv.c --- perl/gv.c#103~30480~ 2007-03-05 15:40:56.000000000 -0800 +++ perl/gv.c 2007-03-22 15:25:21.000000000 -0700 @@ -359,7 +359,7 @@ } gvp = (GV**)hv_fetchs(stash, "ISA", FALSE); - av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL; + av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL; /* create and re-create @.*::SUPER::ISA on demand */ if (!av || !SvMAGIC(av)) { @@ -371,7 +371,7 @@ packlen -= 7; basestash = gv_stashpvn(hvname, packlen, GV_ADD); gvp = (GV**)hv_fetchs(basestash, "ISA", FALSE); - if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { + if (gvp && (gv = *gvp) && isGV_with_GP(gv) && (av = GvAV(gv))) { gvp = (GV**)hv_fetchs(stash, "ISA", TRUE); if (!gvp || !(gv = *gvp)) Perl_croak(aTHX_ "Cannot create %s::ISA", hvname); @@ -677,11 +677,12 @@ if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { dSP; - PUTBACK; ENTER; save_scalar(gv); /* keep the value of $! */ + PUSHSTACKi(PERLSI_MAGIC); Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs("Errno"), NULL); + POPSTACK; LEAVE; SPAGAIN; stash = gv_stashpvs("Errno", 0); ==== //depot/maint-5.8/perl/op.c#208 (text) ==== Index: perl/op.c --- perl/op.c#207~30632~ 2007-03-19 04:54:02.000000000 -0700 +++ perl/op.c 2007-03-22 15:25:21.000000000 -0700 @@ -516,6 +516,7 @@ S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); /* FIXME: treaddead ??? */ + cop->cop_label = NULL; CopFILE_free(cop); CopSTASH_free(cop); if (! specialWARN(cop->cop_warnings)) @@ -2726,6 +2727,7 @@ bits = 8; Safefree(cPVOPo->op_pv); + cPVOPo->op_pv = NULL; swash = (SV*)swash_init("utf8", "", listsv, bits, none); #ifdef USE_ITHREADS @@ -4198,7 +4200,7 @@ /* for XSUBs CvFILE point directly to static memory; __FILE__ */ Safefree(CvFILE(cv)); } - CvFILE(cv) = 0; + CvFILE(cv) = NULL; #endif if (!CvISXSUB(cv) && CvROOT(cv)) { ==== //depot/maint-5.8/perl/perl.c#208 (text) ==== Index: perl/perl.c --- perl/perl.c#207~30480~ 2007-03-05 15:40:56.000000000 -0800 +++ perl/perl.c 2007-03-22 15:25:21.000000000 -0700 @@ -5253,7 +5253,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) { SV *atsv; - const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0; + volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0; CV *cv; STRLEN len; int ret; ==== //depot/maint-5.8/perl/perlio.c#110 (text) ==== Index: perl/perlio.c --- perl/perlio.c#109~30314~ 2007-02-15 05:06:29.000000000 -0800 +++ perl/perlio.c 2007-03-22 15:25:21.000000000 -0700 @@ -5110,8 +5110,8 @@ if (f) PerlIOBase(f)->flags |= PERLIO_F_TEMP; PerlLIO_unlink(SvPVX_const(sv)); - SvREFCNT_dec(sv); } + SvREFCNT_dec(sv); # else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */ FILE * const stdio = PerlSIO_tmpfile(); ==== //depot/maint-5.8/perl/pp_hot.c#136 (text) ==== Index: perl/pp_hot.c --- perl/pp_hot.c#135~30665~ 2007-03-21 11:42:59.000000000 -0700 +++ perl/pp_hot.c 2007-03-22 15:25:21.000000000 -0700 @@ -844,6 +844,7 @@ sv = (SV*)avhv_keys((AV*)sv); TARG = Perl_hv_scalar(aTHX_ (HV *)sv); + SPAGAIN; SETTARG; } } ==== //depot/maint-5.8/perl/pp_sys.c#146 (text) ==== Index: perl/pp_sys.c --- perl/pp_sys.c#145~30585~ 2007-03-14 09:44:53.000000000 -0700 +++ perl/pp_sys.c 2007-03-22 15:25:21.000000000 -0700 @@ -435,6 +435,7 @@ else if (SP == MARK) { tmpsv = &PL_sv_no; EXTEND(SP, 1); + SP = MARK + 1; } else { tmpsv = TOPs; ==== //depot/maint-5.8/perl/t/op/gv.t#9 (xtext) ==== Index: perl/t/op/gv.t --- perl/t/op/gv.t#8~29901~ 2007-01-20 15:44:56.000000000 -0800 +++ perl/t/op/gv.t 2007-03-22 15:25:21.000000000 -0700 @@ -12,7 +12,7 @@ use warnings; require './test.pl'; -plan( tests => 147 ); +plan( tests => 152 ); # type coersion on assignment $foo = 'foo'; @@ -409,6 +409,34 @@ like ($@, qr/^Cannot convert a reference to $type to typeglob/, "Cannot upgrade ref-to-$type to typeglob"); } +{ + # Bug reported by broquaint on IRC + *slosh::{HASH}->{ISA}=[]; + slosh->import; + pass("gv_fetchmeth coped with the unexpected"); + + # An audit found these: + { + package slosh; + sub rip { + my $s = shift; + $s->SUPER::rip; + } + } + eval {slosh->rip;}; + like ($@, qr/^Can't locate object method "rip"/, "Even with SUPER"); + + is(slosh->isa('swoosh'), ''); + + $CORE::GLOBAL::{"lock"}=[]; + eval "no warnings; lock"; + like($@, qr/^Not enough arguments for lock/, + "Can't trip up general keyword overloading"); + + $CORE::GLOBAL::{"readline"}=[]; + eval "<STDOUT> if 0"; + is($@, '', "Can't trip up readline overloading"); +} __END__ Perl Rules ==== //depot/maint-5.8/perl/toke.c#170 (text) ==== Index: perl/toke.c --- perl/toke.c#169~30480~ 2007-03-05 15:40:56.000000000 -0800 +++ perl/toke.c 2007-03-22 15:25:21.000000000 -0700 @@ -4284,7 +4284,7 @@ } if (!ogv && (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) && - (gv = *gvp) != (GV*)&PL_sv_undef && + (gv = *gvp) && isGV_with_GP(gv) && GvCVu(gv) && GvIMPORTED_CV(gv)) { ogv = gv; @@ -9992,7 +9992,7 @@ && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)) || ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE)) - && (gv_readline = *gvp) != (GV*)&PL_sv_undef + && (gv_readline = *gvp) && isGV_with_GP(gv_readline) && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))) readline_overriden = TRUE; ==== //depot/maint-5.8/perl/universal.c#65 (text) ==== Index: perl/universal.c --- perl/universal.c#64~30465~ 2007-03-05 08:57:07.000000000 -0800 +++ perl/universal.c 2007-03-22 15:25:21.000000000 -0700 @@ -61,7 +61,7 @@ gvp = (GV**)hv_fetchs(stash, "::ISA::CACHE::", FALSE); - if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv)) + if (gvp && (gv = *gvp) && isGV_with_GP(gv) && (subgen = GvSV(gv)) && (hv = GvHV(gv))) { if (SvIV(subgen) == (IV)PL_sub_generation) { @@ -86,7 +86,7 @@ gvp = (GV**)hv_fetchs(stash, "ISA", FALSE); - if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { + if (gvp && (gv = *gvp) && isGV_with_GP(gv) && (av = GvAV(gv))) { if (!hv || !subgen) { gvp = (GV**)hv_fetchs(stash, "::ISA::CACHE::", TRUE); ==== //depot/maint-5.8/perl/util.c#148 (text) ==== Index: perl/util.c --- perl/util.c#147~30312~ 2007-02-15 04:28:42.000000000 -0800 +++ perl/util.c 2007-03-22 15:25:21.000000000 -0700 @@ -1138,7 +1138,10 @@ if (CopLINE(cop)) Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf, OutCopFILE(cop), (IV)CopLINE(cop)); - if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) { + /* Seems that GvIO() can be untrustworthy during global destruction. */ + if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO) + && IoLINES(GvIOp(PL_last_in_gv))) + { const bool line_mode = (RsSIMPLE(PL_rs) && SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n'); Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %"IVdf, End of Patch.