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.
