Change 29908 by [EMAIL PROTECTED] on 2007/01/21 21:58:40
Integrate:
[ 27270]
Turn on match string copying when /e flag is set on a substitution.
Subject: [PATCH] dodge a valgrind error (for maint or blead)
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Feb 22, 2006 8:16 PM
Message-ID: <[EMAIL PROTECTED]>
[ 27320]
Given that Perl_gp_free() is refcount-dec-and-maybe-free for the glob
pointer, it's inconsistent that it only sets this GV's GvGP to 0 if
this GV happened to have the last reference. Why should this GV care if
it had the last reference? So always set it to 0. It's free. Gone.
[ 27359]
Don't put strings with embedded NULs in the environment.
This makes things like -d:Foo=bar work again.
[ 27402]
$[ = 2 should not warn.
[ 27403]
This looks like a memory leak.
[ 27436]
Fix a memory leak in ck_grep(), spotted by coverity:
perl -e'eval "grep" while 1'
[ 27448]
The Coverity audit is upset that the scream_olds variable is not
directly initialized, although it is likely initialized after
another variable takes a reference to it.
[ 27476]
Possible NULL pointer reference found by Coverity checks.
[ 27477]
Perl_newWHILEOP() had exactly the same lack of a NULL pointer check
that Perl_newLOOPOP() had and fixed in change #27476. Maybe some
refactoring is needed?
[ 27515]
require should ignore directories found when searching @INC not just
die as soon as it finds one. It should for instance be possible to
for require "File" to read the file "./File" even if there happens to
be a "File" directory in perl's standard library.
This fixes the RT #24404 fix in change 26373.
Affected files ...
... //depot/maint-5.8/perl/gv.c#84 integrate
... //depot/maint-5.8/perl/op.c#164 integrate
... //depot/maint-5.8/perl/perl.c#187 integrate
... //depot/maint-5.8/perl/pp_ctl.c#146 integrate
... //depot/maint-5.8/perl/pp_hot.c#113 integrate
... //depot/maint-5.8/perl/regexec.c#66 integrate
... //depot/maint-5.8/perl/t/comp/require.t#12 integrate
... //depot/maint-5.8/perl/t/lib/warnings/op#8 integrate
Differences ...
==== //depot/maint-5.8/perl/gv.c#84 (text) ====
Index: perl/gv.c
--- perl/gv.c#83~29898~ 2007-01-20 10:43:49.000000000 -0800
+++ perl/gv.c 2007-01-21 13:58:40.000000000 -0800
@@ -1399,6 +1399,7 @@
if (--gp->gp_refcnt > 0) {
if (gp->gp_egv == gv)
gp->gp_egv = 0;
+ GvGP(gv) = 0;
return;
}
==== //depot/maint-5.8/perl/op.c#164 (text) ====
Index: perl/op.c
--- perl/op.c#163~29903~ 2007-01-20 16:16:12.000000000 -0800
+++ perl/op.c 2007-01-21 13:58:40.000000000 -0800
@@ -830,6 +830,8 @@
else {
if (ckWARN(WARN_VOID)) {
useless = "a constant";
+ if (o->op_private & OPpCONST_ARYBASE)
+ useless = 0;
/* don't warn on optimised away booleans, eg
* use constant Foo, 5; Foo || print; */
if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
@@ -1067,7 +1069,7 @@
PL_modcount++;
return o;
case OP_CONST:
- if (!(o->op_private & (OPpCONST_ARYBASE)))
+ if (!(o->op_private & OPpCONST_ARYBASE))
goto nomod;
if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
@@ -3540,7 +3542,9 @@
if (PL_eval_start)
PL_eval_start = 0;
else {
+ op_free(o);
o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
+ o->op_private |= OPpCONST_ARYBASE;
}
}
return o;
@@ -3859,10 +3863,10 @@
break;
case OP_SASSIGN:
- if (k1->op_type == OP_READDIR
+ if (k1 && (k1->op_type == OP_READDIR
|| k1->op_type == OP_GLOB
|| (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
- || k1->op_type == OP_EACH)
+ || k1->op_type == OP_EACH))
expr = newUNOP(OP_DEFINED, 0, expr);
break;
}
@@ -3929,10 +3933,10 @@
break;
case OP_SASSIGN:
- if (k1->op_type == OP_READDIR
+ if (k1 && (k1->op_type == OP_READDIR
|| k1->op_type == OP_GLOB
|| (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
- || k1->op_type == OP_EACH)
+ || k1->op_type == OP_EACH))
expr = newUNOP(OP_DEFINED, 0, expr);
break;
}
@@ -5703,12 +5707,12 @@
OP *
Perl_ck_grep(pTHX_ OP *o)
{
- LOGOP *gwop;
+ LOGOP *gwop = NULL;
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE :
OP_MAPWHILE;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
- NewOp(1101, gwop, 1, LOGOP);
+ /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
if (o->op_flags & OPf_STACKED) {
OP* k;
@@ -5719,6 +5723,7 @@
for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
kid = k;
}
+ NewOp(1101, gwop, 1, LOGOP);
kid->op_next = (OP*)gwop;
o->op_flags &= ~OPf_STACKED;
}
@@ -5735,6 +5740,8 @@
Perl_croak(aTHX_ "panic: ck_grep");
kid = kUNOP->op_first;
+ if (!gwop)
+ NewOp(1101, gwop, 1, LOGOP);
gwop->op_type = type;
gwop->op_ppaddr = PL_ppaddr[type];
gwop->op_first = listkids(o);
==== //depot/maint-5.8/perl/perl.c#187 (text) ====
Index: perl/perl.c
--- perl/perl.c#186~29897~ 2007-01-20 10:14:46.000000000 -0800
+++ perl/perl.c 2007-01-21 13:58:40.000000000 -0800
@@ -3217,7 +3217,9 @@
sv_catpv(sv, start);
else {
sv_catpvn(sv, start, s-start);
- Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
+ /* Don't use NUL as q// delimiter here, this string goes in the
+ * environment. */
+ Perl_sv_catpvf(aTHX_ sv, " split(/,/,q{%s});", ++s);
}
s += strlen(s);
my_setenv("PERL5DB", (char *)SvPV_nolen_const(sv));
==== //depot/maint-5.8/perl/pp_ctl.c#146 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#145~29898~ 2007-01-20 10:43:49.000000000 -0800
+++ perl/pp_ctl.c 2007-01-21 13:58:40.000000000 -0800
@@ -2934,14 +2934,10 @@
{
Stat_t st;
const int st_rc = PerlLIO_stat(name, &st);
- if (st_rc < 0) {
+ if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
return NULL;
}
- if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
- Perl_die(aTHX_ "%s %s not allowed in require",
- S_ISDIR(st.st_mode) ? "Directory" : "Block device", name);
- }
return PerlIO_open(name, mode);
}
==== //depot/maint-5.8/perl/pp_hot.c#113 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#112~29898~ 2007-01-20 10:43:49.000000000 -0800
+++ perl/pp_hot.c 2007-01-21 13:58:40.000000000 -0800
@@ -1342,7 +1342,7 @@
}
}
if ((!global && rx->nparens)
- || SvTEMP(TARG) || PL_sawampersand)
+ || SvTEMP(TARG) || PL_sawampersand || (pm->op_pmflags & PMf_EVAL))
r_flags |= REXEC_COPY_STR;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
@@ -2087,7 +2087,8 @@
pm = PL_curpm;
rx = PM_GETRE(pm);
}
- r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
+ r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand
+ || (pm->op_pmflags & PMf_EVAL))
? REXEC_COPY_STR : 0;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
==== //depot/maint-5.8/perl/regexec.c#66 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#65~29888~ 2007-01-19 13:24:46.000000000 -0800
+++ perl/regexec.c 2007-01-21 13:58:40.000000000 -0800
@@ -1624,7 +1624,7 @@
I32 dontbother = 0; /* how many characters not to try at end */
I32 end_shift = 0; /* Same for the end. */ /* CC */
I32 scream_pos = -1; /* Internal iterator of scream. */
- char *scream_olds;
+ char *scream_olds = NULL;
SV* oreplsv = GvSV(PL_replgv);
const bool do_utf8 = DO_UTF8(sv);
const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
==== //depot/maint-5.8/perl/t/comp/require.t#12 (xtext) ====
Index: perl/t/comp/require.t
--- perl/t/comp/require.t#11~29861~ 2007-01-17 14:36:16.000000000 -0800
+++ perl/t/comp/require.t 2007-01-21 13:58:40.000000000 -0800
@@ -151,7 +151,7 @@
my $r = "threads";
eval { require $r };
$i++;
-if($@ =~ /Directory .*threads not allowed in require/) {
+if($@ =~ /Can't locate threads in [EMAIL PROTECTED]/) {
print "ok $i\n";
} else {
print "not ok $i\n";
==== //depot/maint-5.8/perl/t/lib/warnings/op#8 (text) ====
Index: perl/t/lib/warnings/op
--- perl/t/lib/warnings/op#7~22398~ 2004-02-27 05:37:30.000000000 -0800
+++ perl/t/lib/warnings/op 2007-01-21 13:58:40.000000000 -0800
@@ -531,6 +531,7 @@
5 || print "bad\n"; # test OPpCONST_SHORTCIRCUIT
use constant U => undef;
print "boo\n" if U; # test OPpCONST_SHORTCIRCUIT
+$[ = 2; # should not warn
no warnings 'void' ;
"abc"; # OP_CONST
7 ; # OP_CONST
End of Patch.
