Change 29952 by [EMAIL PROTECTED] on 2007/01/24 16:46:32
Integrate:
[ 27871]
Subject: Re: [PATCH] update to pp_complement() via Coverity
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Message-Id: <[EMAIL PROTECTED]>
Date: Sun, 16 Apr 2006 18:45:37 +0900
Subject: Re: [PATCH] update to pp_complement() via Coverity
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Message-Id: <[EMAIL PROTECTED]>
Date: Mon, 17 Apr 2006 23:06:21 +0900
[ 27877]
Coverity is upset about a signed int in ext/Filter/Util/Call/Call.xs,
but the real problem is down in Perl_filter_read() in toke.c.
[ 27882]
Coverity insists that if we deference a pointer without checking, and
subsequently check that same pointer before deferencing it, something
in our code or our logic is bogus. So assert() that it's safe the
first time and remove the second check.
[ 27895]
Fix compilation of microperl, which doesn't have INT_MAX.
[ 27897]
Replace some Copy() by Move() calls, because valgrind reports
we can have overlapping memory areas here
[ 27908]
Subject: [PATCH] Localizing vars
From: [EMAIL PROTECTED] (Andy Lester)
Date: Wed, 19 Apr 2006 23:44:01 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 27910]
Subject: [PATCH] op_type shrinking
From: [EMAIL PROTECTED] (Andy Lester)
Date: Wed, 19 Apr 2006 23:16:53 -0500
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/doop.c#46 integrate
... //depot/maint-5.8/perl/dump.c#65 integrate
... //depot/maint-5.8/perl/pp.c#122 integrate
... //depot/maint-5.8/perl/regcomp.c#84 integrate
... //depot/maint-5.8/perl/sv.c#310 integrate
... //depot/maint-5.8/perl/t/op/bop.t#7 integrate
... //depot/maint-5.8/perl/toke.c#141 integrate
... //depot/maint-5.8/perl/util.c#125 integrate
Differences ...
==== //depot/maint-5.8/perl/doop.c#46 (text) ====
Index: perl/doop.c
--- perl/doop.c#45~29951~ 2007-01-24 08:24:04.000000000 -0800
+++ perl/doop.c 2007-01-24 08:46:32.000000000 -0800
@@ -211,7 +211,7 @@
if (comp > 0xff) {
if (!complement) {
- Copy(s, d, len, U8);
+ Move(s, d, len, U8);
d += len;
}
else {
@@ -239,7 +239,7 @@
continue;
}
else if (ch == -1) { /* -1 is unmapped character */
- Copy(s, d, len, U8);
+ Move(s, d, len, U8);
d += len;
}
else if (ch == -2) /* -2 is delete character */
@@ -273,7 +273,7 @@
matches++;
}
else if (ch == -1) { /* -1 is unmapped character */
- Copy(s, d, len, U8);
+ Move(s, d, len, U8);
d += len;
}
else if (ch == -2) /* -2 is delete character */
==== //depot/maint-5.8/perl/dump.c#65 (text) ====
Index: perl/dump.c
--- perl/dump.c#64~29947~ 2007-01-24 05:54:09.000000000 -0800
+++ perl/dump.c 2007-01-24 08:46:32.000000000 -0800
@@ -413,6 +413,8 @@
void
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
{
+ const OPCODE optype = o->op_type;
+
Perl_dump_indent(aTHX_ level, file, "{\n");
level++;
if (o->op_seq)
@@ -431,11 +433,9 @@
else
PerlIO_printf(file, "DONE\n");
if (o->op_targ) {
- if (o->op_type == OP_NULL)
- {
+ if (optype == OP_NULL) {
Perl_dump_indent(aTHX_ level, file, " (was %s)\n",
PL_op_name[o->op_targ]);
- if (o->op_targ == OP_NEXTSTATE)
- {
+ if (o->op_targ == OP_NEXTSTATE) {
if (CopLINE(cCOPo))
Perl_dump_indent(aTHX_ level, file, "LINE = %"UVf"\n",
(UV)CopLINE(cCOPo));
@@ -454,7 +454,7 @@
Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n",
(UV)o, (UV)o->op_next);
#endif
if (o->op_flags) {
- SV *tmpsv = newSVpvs("");
+ SV * const tmpsv = newSVpvs("");
switch (o->op_flags & OPf_WANT) {
case OPf_WANT_VOID:
sv_catpv(tmpsv, ",VOID");
@@ -485,29 +485,29 @@
SvREFCNT_dec(tmpsv);
}
if (o->op_private) {
- SV *tmpsv = newSVpvs("");
- if (PL_opargs[o->op_type] & OA_TARGLEX) {
+ SV * const tmpsv = newSVpvs("");
+ if (PL_opargs[optype] & OA_TARGLEX) {
if (o->op_private & OPpTARGET_MY)
sv_catpv(tmpsv, ",TARGET_MY");
}
- else if (o->op_type == OP_LEAVESUB ||
- o->op_type == OP_LEAVE ||
- o->op_type == OP_LEAVESUBLV ||
- o->op_type == OP_LEAVEWRITE) {
+ else if (optype == OP_LEAVESUB ||
+ optype == OP_LEAVE ||
+ optype == OP_LEAVESUBLV ||
+ optype == OP_LEAVEWRITE) {
if (o->op_private & OPpREFCOUNTED)
sv_catpv(tmpsv, ",REFCOUNTED");
}
- else if (o->op_type == OP_AASSIGN) {
+ else if (optype == OP_AASSIGN) {
if (o->op_private & OPpASSIGN_COMMON)
sv_catpv(tmpsv, ",COMMON");
if (o->op_private & OPpASSIGN_HASH)
sv_catpv(tmpsv, ",HASH");
}
- else if (o->op_type == OP_SASSIGN) {
+ else if (optype == OP_SASSIGN) {
if (o->op_private & OPpASSIGN_BACKWARDS)
sv_catpv(tmpsv, ",BACKWARDS");
}
- else if (o->op_type == OP_TRANS) {
+ else if (optype == OP_TRANS) {
if (o->op_private & OPpTRANS_SQUASH)
sv_catpv(tmpsv, ",SQUASH");
if (o->op_private & OPpTRANS_DELETE)
@@ -519,20 +519,20 @@
if (o->op_private & OPpTRANS_GROWS)
sv_catpv(tmpsv, ",GROWS");
}
- else if (o->op_type == OP_REPEAT) {
+ else if (optype == OP_REPEAT) {
if (o->op_private & OPpREPEAT_DOLIST)
sv_catpv(tmpsv, ",DOLIST");
}
- else if (o->op_type == OP_ENTERSUB ||
- o->op_type == OP_RV2SV ||
- o->op_type == OP_GVSV ||
- o->op_type == OP_RV2AV ||
- o->op_type == OP_RV2HV ||
- o->op_type == OP_RV2GV ||
- o->op_type == OP_AELEM ||
- o->op_type == OP_HELEM )
+ else if (optype == OP_ENTERSUB ||
+ optype == OP_RV2SV ||
+ optype == OP_GVSV ||
+ optype == OP_RV2AV ||
+ optype == OP_RV2HV ||
+ optype == OP_RV2GV ||
+ optype == OP_AELEM ||
+ optype == OP_HELEM )
{
- if (o->op_type == OP_ENTERSUB) {
+ if (optype == OP_ENTERSUB) {
if (o->op_private & OPpENTERSUB_AMPER)
sv_catpv(tmpsv, ",AMPER");
if (o->op_private & OPpENTERSUB_DB)
@@ -561,7 +561,7 @@
if (o->op_private & OPpMAYBE_LVSUB)
sv_catpv(tmpsv, ",MAYBE_LVSUB");
}
- if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
+ if (optype == OP_AELEM || optype == OP_HELEM) {
if (o->op_private & OPpLVAL_DEFER)
sv_catpv(tmpsv, ",LVAL_DEFER");
}
@@ -572,7 +572,7 @@
sv_catpv(tmpsv, ",OUR_INTRO");
}
}
- else if (o->op_type == OP_CONST) {
+ else if (optype == OP_CONST) {
if (o->op_private & OPpCONST_BARE)
sv_catpv(tmpsv, ",BARE");
if (o->op_private & OPpCONST_STRICT)
@@ -584,35 +584,35 @@
if (o->op_private & OPpCONST_ENTERED)
sv_catpv(tmpsv, ",ENTERED");
}
- else if (o->op_type == OP_FLIP) {
+ else if (optype == OP_FLIP) {
if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- else if (o->op_type == OP_FLOP) {
+ else if (optype == OP_FLOP) {
if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- else if (o->op_type == OP_RV2CV) {
+ else if (optype == OP_RV2CV) {
if (o->op_private & OPpLVAL_INTRO)
sv_catpv(tmpsv, ",INTRO");
}
- else if (o->op_type == OP_GV) {
+ else if (optype == OP_GV) {
if (o->op_private & OPpEARLY_CV)
sv_catpv(tmpsv, ",EARLY_CV");
}
- else if (o->op_type == OP_LIST) {
+ else if (optype == OP_LIST) {
if (o->op_private & OPpLIST_GUESSED)
sv_catpv(tmpsv, ",GUESSED");
}
- else if (o->op_type == OP_DELETE) {
+ else if (optype == OP_DELETE) {
if (o->op_private & OPpSLICE)
sv_catpv(tmpsv, ",SLICE");
}
- else if (o->op_type == OP_EXISTS) {
+ else if (optype == OP_EXISTS) {
if (o->op_private & OPpEXISTS_SUB)
sv_catpv(tmpsv, ",EXISTS_SUB");
}
- else if (o->op_type == OP_SORT) {
+ else if (optype == OP_SORT) {
if (o->op_private & OPpSORT_NUMERIC)
sv_catpv(tmpsv, ",NUMERIC");
if (o->op_private & OPpSORT_INTEGER)
@@ -620,11 +620,11 @@
if (o->op_private & OPpSORT_REVERSE)
sv_catpv(tmpsv, ",REVERSE");
}
- else if (o->op_type == OP_THREADSV) {
+ else if (optype == OP_THREADSV) {
if (o->op_private & OPpDONE_SVREF)
sv_catpv(tmpsv, ",SVREF");
}
- else if (o->op_type == OP_OPEN || o->op_type == OP_BACKTICK) {
+ else if (optype == OP_OPEN || optype == OP_BACKTICK) {
if (o->op_private & OPpOPEN_IN_RAW)
sv_catpv(tmpsv, ",IN_RAW");
if (o->op_private & OPpOPEN_IN_CRLF)
@@ -634,13 +634,13 @@
if (o->op_private & OPpOPEN_OUT_CRLF)
sv_catpv(tmpsv, ",OUT_CRLF");
}
- else if (o->op_type == OP_EXIT) {
+ else if (optype == OP_EXIT) {
if (o->op_private & OPpEXIT_VMSISH)
sv_catpv(tmpsv, ",EXIT_VMSISH");
if (o->op_private & OPpHUSH_VMSISH)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
- else if (o->op_type == OP_DIE) {
+ else if (optype == OP_DIE) {
if (o->op_private & OPpHUSH_VMSISH)
sv_catpv(tmpsv, ",HUSH_VMSISH");
}
@@ -655,7 +655,7 @@
SvREFCNT_dec(tmpsv);
}
- switch (o->op_type) {
+ switch (optype) {
case OP_AELEMFAST:
case OP_GVSV:
case OP_GV:
==== //depot/maint-5.8/perl/pp.c#122 (text) ====
Index: perl/pp.c
--- perl/pp.c#121~29951~ 2007-01-24 08:24:04.000000000 -0800
+++ perl/pp.c 2007-01-24 08:46:32.000000000 -0800
@@ -2455,10 +2455,12 @@
UV nchar = 0;
UV nwide = 0;
U8 * const send = tmps + len;
+ U8 * const origtmps = tmps;
+ const UV utf8flags = UTF8_ALLOW_ANYUV;
while (tmps < send) {
- const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
- tmps += UTF8SKIP(tmps);
+ const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
+ tmps += l;
targlen += UNISKIP(~c);
nchar++;
if (c > 0xff)
@@ -2466,17 +2468,17 @@
}
/* Now rewind strings and write them. */
- tmps -= len;
+ tmps = origtmps;
if (nwide) {
U8 *result;
U8 *p;
- Newxz(result, targlen + 1, U8);
+ Newx(result, targlen + 1, U8);
p = result;
while (tmps < send) {
- const UV c = utf8n_to_uvchr(tmps, send-tmps, &l,
UTF8_ALLOW_ANYUV);
- tmps += UTF8SKIP(tmps);
+ const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
+ tmps += l;
p = uvchr_to_utf8_flags(p, ~c, UNICODE_ALLOW_ANY);
}
*p = '\0';
@@ -2488,11 +2490,11 @@
U8 *result;
U8 *p;
- Newxz(result, nchar + 1, U8);
+ Newx(result, nchar + 1, U8);
p = result;
while (tmps < send) {
- const U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
- tmps += UTF8SKIP(tmps);
+ const U8 c = (U8)utf8n_to_uvchr(tmps, send-tmps, &l,
utf8flags);
+ tmps += l;
*p++ = ~c;
}
*p = '\0';
==== //depot/maint-5.8/perl/regcomp.c#84 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#83~29949~ 2007-01-24 07:28:38.000000000 -0800
+++ perl/regcomp.c 2007-01-24 08:46:32.000000000 -0800
@@ -956,15 +956,17 @@
UV uc = *((U8*)STRING(scan));
/* Search for fixed substrings supports EXACT only. */
- if (flags & SCF_DO_SUBSTR)
+ if (flags & SCF_DO_SUBSTR) {
+ assert(data);
scan_commit(pRExC_state, data);
+ }
if (UTF) {
U8 * const s = (U8 *)STRING(scan);
l = utf8_length(s, s + l);
uc = utf8_to_uvchr(s, NULL);
}
min += l;
- if (data && (flags & SCF_DO_SUBSTR))
+ if (flags & SCF_DO_SUBSTR)
data->pos_min += l;
if (flags & SCF_DO_STCLASS_AND) {
/* Check whether it is compatible with what we know already! */
==== //depot/maint-5.8/perl/t/op/bop.t#7 (xtext) ====
Index: perl/t/op/bop.t
--- perl/t/op/bop.t#6~29950~ 2007-01-24 07:42:09.000000000 -0800
+++ perl/t/op/bop.t 2007-01-24 08:46:32.000000000 -0800
@@ -15,7 +15,7 @@
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 160;
+plan tests => 161;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -415,3 +415,19 @@
is($b, chr(0x1FE) x 0x0FF . chr(0x101) x 2);
}
+# update to pp_complement() via Coverity
+SKIP: {
+ # UTF-EBCDIC is limited to 0x7fffffff and can't encode ~0.
+ skip "EBCDIC" if $Is_EBCDIC;
+
+ my $str = "\x{10000}\x{800}";
+ # U+10000 is four bytes in UTF-8/UTF-EBCDIC.
+ # U+0800 is three bytes in UTF-8/UTF-EBCDIC.
+
+ no warnings "utf8";
+ { use bytes; $str =~ s/\C\C\z//; }
+
+ # it's really bogus that (~~malformed) is \0.
+ my $ref = "\x{10000}\0";
+ is(~~$str, $ref);
+}
==== //depot/maint-5.8/perl/toke.c#141 (text) ====
Index: perl/toke.c
--- perl/toke.c#140~29929~ 2007-01-22 15:29:42.000000000 -0800
+++ perl/toke.c 2007-01-24 08:46:32.000000000 -0800
@@ -2257,6 +2257,17 @@
{
filter_t funcp;
SV *datasv = NULL;
+ /* This API is bad. It should have been using unsigned int for maxlen.
+ Not sure if we want to change the API, but if not we should sanity
+ check the value here. */
+ const unsigned int correct_length
+ = maxlen < 0 ?
+#ifdef PERL_MICRO
+ 0x7FFFFFFF
+#else
+ INT_MAX
+#endif
+ : maxlen;
if (!PL_rsfp_filters)
return -1;
@@ -2265,14 +2276,15 @@
/* Note that we append to the line. This is handy. */
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: from rsfp\n", idx));
- if (maxlen) {
+ if (correct_length) {
/* Want a block */
int len ;
const int old_len = SvCUR(buf_sv);
/* ensure buf_sv is large enough */
- SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ;
- if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen))
<= 0){
+ SvGROW(buf_sv, (STRLEN)(old_len + correct_length)) ;
+ if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len,
+ correct_length)) <= 0) {
if (PerlIO_error(PL_rsfp))
return -1; /* error */
else
@@ -2295,7 +2307,7 @@
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: skipped (filter deleted)\n",
idx));
- return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
+ return FILTER_READ(idx+1, buf_sv, correct_length); /* recurse */
}
/* Get function pointer hidden within datasv */
funcp = DPTR2FPTR(filter_t, IoANY(datasv));
@@ -2305,7 +2317,7 @@
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
- return (*funcp)(aTHX_ idx, buf_sv, maxlen);
+ return (*funcp)(aTHX_ idx, buf_sv, correct_length);
}
STATIC char *
==== //depot/maint-5.8/perl/util.c#125 (text) ====
Index: perl/util.c
--- perl/util.c#124~29928~ 2007-01-22 15:12:43.000000000 -0800
+++ perl/util.c 2007-01-24 08:46:32.000000000 -0800
@@ -3685,15 +3685,6 @@
void
Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
{
- const char * const func =
- op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
- op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
- op < 0 ? "" : /* handle phoney cases */
- PL_op_desc[op];
- const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
- const char * const type = OP_IS_SOCKET(op)
- || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
- ? "socket" : "filehandle";
const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
@@ -3722,6 +3713,15 @@
}
if (ckWARN(warn_type)) {
+ const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+ const char * const func =
+ op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice
*/
+ op == OP_LEAVEWRITE ? "write" : /* "write exit" not
nice */
+ op < 0 ? "" : /* handle phoney cases
*/
+ PL_op_desc[op];
+ const char * const type = OP_IS_SOCKET(op)
+ || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
+ ? "socket" : "filehandle";
if (name && *name) {
Perl_warner(aTHX_ packWARN(warn_type),
"%s%s on %s %s %s", func, pars, vile, type, name);
End of Patch.
