Change 29804 by [EMAIL PROTECTED] on 2007/01/14 12:22:41
Integrate:
[ 26643]
Fix some compilation warnings
[ 26674]
Subject: [PATCH] performance tweaking op.c
From: Andy Lester <[EMAIL PROTECTED]>
Date: Fri, 6 Jan 2006 01:44:48 -0600
Message-ID: <[EMAIL PROTECTED]>
[ 26708]
Subject: [PATCH] blead: format warnings
Date: Sat, 07 Jan 2006 21:42:08 +0200
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
[ 26764]
Subject: [PATCH] It's the Barbie bus patch
From: Andy Lester <[EMAIL PROTECTED]>
Date: Mon, 9 Jan 2006 23:42:43 -0600
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/av.c#38 integrate
... //depot/maint-5.8/perl/doio.c#84 integrate
... //depot/maint-5.8/perl/embed.fnc#164 integrate
... //depot/maint-5.8/perl/embed.h#124 integrate
... //depot/maint-5.8/perl/gv.c#79 integrate
... //depot/maint-5.8/perl/hv.c#91 edit
... //depot/maint-5.8/perl/mg.c#120 integrate
... //depot/maint-5.8/perl/op.c#155 edit
... //depot/maint-5.8/perl/pad.c#54 integrate
... //depot/maint-5.8/perl/pp_ctl.c#136 integrate
... //depot/maint-5.8/perl/pp_hot.c#109 integrate
... //depot/maint-5.8/perl/pp_sys.c#120 integrate
... //depot/maint-5.8/perl/proto.h#153 integrate
... //depot/maint-5.8/perl/reentr.c#17 integrate
... //depot/maint-5.8/perl/reentr.h#17 integrate
... //depot/maint-5.8/perl/regcomp.c#76 edit
... //depot/maint-5.8/perl/regexec.c#63 integrate
... //depot/maint-5.8/perl/sv.c#278 integrate
... //depot/maint-5.8/perl/toke.c#127 integrate
... //depot/maint-5.8/perl/uconfig.sh#15 integrate
... //depot/maint-5.8/perl/util.c#115 integrate
Differences ...
==== //depot/maint-5.8/perl/av.c#38 (text) ====
Index: perl/av.c
--- perl/av.c#37~29792~ 2007-01-13 10:44:35.000000000 -0800
+++ perl/av.c 2007-01-14 04:22:41.000000000 -0800
@@ -360,7 +360,7 @@
sv_upgrade((SV *)av, SVt_PVAV);
/* sv_upgrade does AvREAL_only() */
AvALLOC(av) = 0;
- SvPV_set(av, (char*)0);
+ SvPV_set(av, NULL);
AvMAX(av) = AvFILLp(av) = -1;
return av;
}
@@ -477,7 +477,7 @@
}
Safefree(AvALLOC(av));
AvALLOC(av) = 0;
- SvPV_set(av, (char*)0);
+ SvPV_set(av, NULL);
AvMAX(av) = AvFILLp(av) = -1;
/* Need to check SvMAGICAL, as during global destruction it may be that
AvARYLEN(av) has been freed before av, and hence the SvANY() pointer
==== //depot/maint-5.8/perl/doio.c#84 (text) ====
Index: perl/doio.c
--- perl/doio.c#83~29800~ 2007-01-13 15:25:42.000000000 -0800
+++ perl/doio.c 2007-01-14 04:22:41.000000000 -0800
@@ -1394,7 +1394,7 @@
#else
if (sp > mark) {
char **a;
- const char *tmps = Nullch;
+ const char *tmps = NULL;
Newx(PL_Argv, sp - mark + 1, char*);
a = PL_Argv;
@@ -1404,7 +1404,7 @@
else
*a++ = "";
}
- *a = Nullch;
+ *a = NULL;
if (really)
tmps = SvPV_nolen_const(really);
if ((!really && *PL_Argv[0] != '/') ||
@@ -1554,7 +1554,7 @@
if (*s)
*s++ = '\0';
}
- *a = Nullch;
+ *a = NULL;
if (PL_Argv[0]) {
PERL_FPU_PRE_EXEC
PerlProc_execvp(PL_Argv[0],PL_Argv);
@@ -1563,15 +1563,13 @@
do_execfree();
goto doshell;
}
- {
- if (ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
- PL_Argv[0], Strerror(errno));
- if (do_report) {
- const int e = errno;
- PerlLIO_write(fd, (void*)&e, sizeof(int));
- PerlLIO_close(fd);
- }
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+ PL_Argv[0], Strerror(errno));
+ if (do_report) {
+ const int e = errno;
+ PerlLIO_write(fd, (const void*)&e, sizeof(int));
+ PerlLIO_close(fd);
}
}
do_execfree();
==== //depot/maint-5.8/perl/embed.fnc#164 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#163~29787~ 2007-01-13 09:24:48.000000000 -0800
+++ perl/embed.fnc 2007-01-14 04:22:41.000000000 -0800
@@ -1260,7 +1260,6 @@
|bool do_utf8sv_is_utf8
Es |CHECKPOINT|regcppush |I32 parenfloor
Es |char*|regcppop
-Es |char*|regcp_set_to |I32 ss
Es |void |cache_re |NN regexp *prog
ERs |U8* |reghop |NN U8 *pos|I32 off
ERs |U8* |reghop3 |NN U8 *pos|I32 off|NN U8 *lim
==== //depot/maint-5.8/perl/embed.h#124 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#123~29787~ 2007-01-13 09:24:48.000000000 -0800
+++ perl/embed.h 2007-01-14 04:22:41.000000000 -0800
@@ -1296,7 +1296,6 @@
#define reginclass S_reginclass
#define regcppush S_regcppush
#define regcppop S_regcppop
-#define regcp_set_to S_regcp_set_to
#define cache_re S_cache_re
#define reghop S_reghop
#define reghop3 S_reghop3
@@ -3357,7 +3356,6 @@
#define reginclass(a,b,c,d) S_reginclass(aTHX_ a,b,c,d)
#define regcppush(a) S_regcppush(aTHX_ a)
#define regcppop() S_regcppop(aTHX)
-#define regcp_set_to(a) S_regcp_set_to(aTHX_ a)
#define cache_re(a) S_cache_re(aTHX_ a)
#define reghop(a,b) S_reghop(aTHX_ a,b)
#define reghop3(a,b,c) S_reghop3(aTHX_ a,b,c)
==== //depot/maint-5.8/perl/gv.c#79 (text) ====
Index: perl/gv.c
--- perl/gv.c#78~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/gv.c 2007-01-14 04:22:41.000000000 -0800
@@ -446,20 +446,20 @@
GV **gvp;
if (!stash)
- return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */
+ return NULL; /* UNIVERSAL::AUTOLOAD could cause trouble */
if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
- return Nullgv;
+ return NULL;
if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
- return Nullgv;
+ return NULL;
cv = GvCV(gv);
if (!(CvROOT(cv) || CvXSUB(cv)))
- return Nullgv;
+ return NULL;
/* Have an autoload */
if (level < 0) /* Cannot do without a stub */
gv_fetchmeth(stash, name, len, 0);
gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
if (!gvp)
- return Nullgv;
+ return NULL;
return *gvp;
}
return gv;
@@ -1479,9 +1479,9 @@
for (i = 1; i < lim; i++)
amt.table[i] = Nullcv;
for (; i < NofAMmeth; i++) {
- const char *cooky = PL_AMG_names[i];
+ const char * const cooky = PL_AMG_names[i];
/* Human-readable form, for debugging: */
- const char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
+ const char * const cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
const STRLEN l = strlen(cooky);
DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package
\"%.256s\"\n",
@@ -1505,7 +1505,7 @@
/* This is a hack to support autoloading..., while
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
- GV *ngv = Nullgv;
+ GV *ngv = NULL;
SV *gvsv = GvSV(gv);
DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
==== //depot/maint-5.8/perl/hv.c#91 (text) ====
Index: perl/hv.c
--- perl/hv.c#90~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/hv.c 2007-01-14 04:22:41.000000000 -0800
@@ -405,8 +405,7 @@
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
- if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS)))
- {
+ if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS)))
{
if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
@@ -511,7 +510,7 @@
/* Will need to free this, so set FREEKEY flag. */
key = savepvn(key,klen);
key = (const char*)strupr((char*)key);
- is_utf8 = 0;
+ is_utf8 = FALSE;
hash = 0;
keysv = 0;
@@ -554,7 +553,7 @@
/* Will need to free this, so set FREEKEY flag. */
key = savepvn(key,klen);
key = (const char*)strupr((char*)key);
- is_utf8 = 0;
+ is_utf8 = FALSE;
hash = 0;
keysv = 0;
@@ -661,7 +660,7 @@
/* Need to swap the key we have for a key with the flags we
need. As keys are shared we can't just write to the
flag, so we share the new one, unshare the old one. */
- HEK *new_hek = share_hek_flags(key, klen, hash,
+ HEK * const new_hek = share_hek_flags(key, klen, hash,
masked_flags);
unshare_hek (HeKEY_hek(entry));
HeKEY_hek(entry) = new_hek;
@@ -869,13 +868,14 @@
Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
{
STRLEN klen;
- int k_flags = 0;
+ int k_flags;
if (klen_i32 < 0) {
klen = -klen_i32;
- k_flags |= HVhek_UTF8;
+ k_flags = HVhek_UTF8;
} else {
klen = klen_i32;
+ k_flags = 0;
}
return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0);
}
@@ -906,7 +906,6 @@
register HE *entry;
register HE **oentry;
HE *const *first_entry;
- SV *sv;
bool is_utf8;
int masked_flags;
@@ -929,6 +928,7 @@
hv_magic_check (hv, &needs_copy, &needs_store);
if (needs_copy) {
+ SV *sv;
entry = hv_fetch_common(hv, keysv, key, klen,
k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE,
NULL, hash);
@@ -1004,6 +1004,7 @@
first_entry = oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
entry = *oentry;
for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
+ SV *sv;
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != (I32)klen)
@@ -1014,13 +1015,12 @@
continue;
/* if placeholder is here, it's already been deleted.... */
- if (HeVAL(entry) == &PL_sv_placeholder)
- {
- if (k_flags & HVhek_FREEKEY)
- Safefree(key);
- return Nullsv;
+ if (HeVAL(entry) == &PL_sv_placeholder) {
+ if (k_flags & HVhek_FREEKEY)
+ Safefree(key);
+ return NULL;
}
- else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+ if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
S_hv_notallowed(aTHX_ k_flags, key, klen,
"Attempt to delete readonly key '%"SVf"' from"
" a restricted hash");
@@ -1290,8 +1290,9 @@
if (!*aep) /* non-existent */
continue;
for (oentry = aep, entry = *aep; entry; entry = *oentry) {
- register I32 j;
- if ((j = (HeHASH(entry) & newsize)) != i) {
+ register I32 j = (HeHASH(entry) & newsize);
+
+ if (j != i) {
j -= i;
*oentry = HeNEXT(entry);
if (!(HeNEXT(entry) = aep[j]))
@@ -1357,7 +1358,7 @@
/* In each bucket... */
for (i = 0; i <= hv_max; i++) {
- HE *prev = NULL, *ent = NULL;
+ HE *prev = NULL;
HE *oent = oents[i];
if (!oent) {
@@ -1371,8 +1372,8 @@
const char * const key = HeKEY(oent);
const STRLEN len = HeKLEN(oent);
const int flags = HeKFLAGS(oent);
+ HE * const ent = new_HE();
- ent = new_HE();
HeVAL(ent) = newSVsv(HeVAL(oent));
HeKEY_hek(ent)
= shared ? share_hek_flags(key, len, hash, flags)
@@ -1478,7 +1479,7 @@
/* not already placeholder */
if (HeVAL(entry) != &PL_sv_placeholder) {
if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
- SV* keysv = hv_iterkeysv(entry);
+ SV* const keysv = hv_iterkeysv(entry);
Perl_croak(aTHX_
"Attempt to delete readonly key '%"SVf"' from a restricted hash",
keysv);
@@ -1533,7 +1534,7 @@
i = HvMAX(hv);
do {
/* Loop down the linked list heads */
- bool first = 1;
+ bool first = TRUE;
HE **oentry = &(HvARRAY(hv))[i];
HE *entry;
@@ -1557,7 +1558,7 @@
}
} else {
oentry = &HeNEXT(entry);
- first = 0;
+ first = FALSE;
}
}
} while (--i >= 0);
@@ -1661,7 +1662,7 @@
hv_free_ent(hv, entry);
}
xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
- xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ xhv->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
/* used to be xhv->xhv_fill before 5.004_65 */
return HvTOTALKEYS(hv);
}
==== //depot/maint-5.8/perl/mg.c#120 (text) ====
Index: perl/mg.c
--- perl/mg.c#119~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/mg.c 2007-01-14 04:22:41.000000000 -0800
@@ -1006,13 +1006,13 @@
case '(':
sv_setiv(sv, (IV)PL_gid);
#ifdef HAS_GETGROUPS
- Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_gid);
+ Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
#endif
goto add_groups;
case ')':
sv_setiv(sv, (IV)PL_egid);
#ifdef HAS_GETGROUPS
- Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_egid);
+ Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
#endif
add_groups:
#ifdef HAS_GETGROUPS
@@ -1023,7 +1023,7 @@
num_groups = getgroups(num_groups, gary);
while (--num_groups >= 0)
Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f,
- (long unsigned int)gary[num_groups]);
+ gary[num_groups]);
Safefree(gary);
}
#endif
@@ -1274,7 +1274,7 @@
PL_psig_name[i]=0;
}
if(PL_psig_ptr[i]) {
- SV *to_dec=PL_psig_ptr[i];
+ SV * const to_dec=PL_psig_ptr[i];
PL_psig_ptr[i]=0;
LEAVE;
SvREFCNT_dec(to_dec);
@@ -1946,12 +1946,11 @@
SV * const lsv = LvTARG(sv);
PERL_UNUSED_ARG(mg);
- if (!lsv) {
+ if (lsv)
+ sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
+ else
SvOK_off(sv);
- return 0;
- }
- sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
return 0;
}
==== //depot/maint-5.8/perl/op.c#155 (text) ====
Index: perl/op.c
--- perl/op.c#154~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/op.c 2007-01-14 04:22:41.000000000 -0800
@@ -209,10 +209,11 @@
Perl_allocmy(pTHX_ char *name)
{
PADOFFSET off;
+ const bool is_our = (PL_in_my == KEY_our);
/* complain about "my $_" etc etc */
if (*name &&
- !(PL_in_my == KEY_our ||
+ !(is_our ||
isALPHA(name[1]) ||
(USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
(name[1] == '_' && name[2])))
@@ -244,22 +245,19 @@
yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
}
/* check for duplicate declaration */
- pad_check_dup(name,
- (bool)(PL_in_my == KEY_our),
- (PL_curstash ? PL_curstash : PL_defstash)
- );
+ pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash));
if (PL_in_my_stash && *name != '$') {
yyerror(Perl_form(aTHX_
"Can't declare class for non-scalar %s in \"%s\"",
- name, PL_in_my == KEY_our ? "our" : "my"));
+ name, is_our ? "our" : "my"));
}
/* allocate a spare slot and store the name in that slot */
off = pad_add_name(name,
PL_in_my_stash,
- (PL_in_my == KEY_our
+ (is_our
? (PL_curstash ? PL_curstash : PL_defstash)
: NULL
),
@@ -576,19 +574,25 @@
OP *
Perl_linklist(pTHX_ OP *o)
{
+ OP *first;
if (o->op_next)
return o->op_next;
/* establish postfix order */
- if (cUNOPo->op_first) {
+ first = cUNOPo->op_first;
+ if (first) {
register OP *kid;
- o->op_next = LINKLIST(cUNOPo->op_first);
- for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
- if (kid->op_sibling)
+ o->op_next = LINKLIST(first);
+ kid = first;
+ for (;;) {
+ if (kid->op_sibling) {
kid->op_next = LINKLIST(kid->op_sibling);
- else
+ kid = kid->op_sibling;
+ } else {
kid->op_next = o;
+ break;
+ }
}
}
else
@@ -844,9 +848,10 @@
built upon these three nroff macros being used in
void context. The pink camel has the details in
the script wrapman near page 319. */
- if (strnEQ(SvPVX_const(sv), "di", 2) ||
- strnEQ(SvPVX_const(sv), "ds", 2) ||
- strnEQ(SvPVX_const(sv), "ig", 2))
+ const char * const maybe_macro = SvPVX_const(sv);
+ if (strnEQ(maybe_macro, "di", 2) ||
+ strnEQ(maybe_macro, "ds", 2) ||
+ strnEQ(maybe_macro, "ig", 2))
useless = 0;
}
}
@@ -1603,13 +1608,12 @@
; /* already in %INC */
else
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
- newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
- Nullsv);
+ newSVpvs(ATTRSMODULE), NULL);
}
else {
Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
- newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
- Nullsv,
+ newSVpvs(ATTRSMODULE),
+ NULL,
prepend_elem(OP_LIST,
newSVOP(OP_CONST, 0, stashsv),
prepend_elem(OP_LIST,
@@ -1637,7 +1641,7 @@
apply_attrs(stash, PAD_SV(target->op_targ), attrs, TRUE);
/* Need package name for method call. */
- pack = newSVOP(OP_CONST, 0, newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
+ pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE));
/* Build up the real arg-list. */
if (stash)
@@ -1704,7 +1708,7 @@
}
Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
- newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
+ newSVpvs(ATTRSMODULE),
NULL, prepend_elem(OP_LIST,
newSVOP(OP_CONST, 0, newSVpv(stashpv,0)),
prepend_elem(OP_LIST,
@@ -2062,12 +2066,12 @@
Perl_jmaybe(pTHX_ OP *o)
{
if (o->op_type == OP_LIST) {
- OP *o2;
#ifdef USE_5005THREADS
- o2 = newOP(OP_THREADSV, 0);
+ OP * const o2 = newOP(OP_THREADSV, 0);
o2->op_targ = find_threadsv(";");
#else
- o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", GV_ADD, SVt_PV))),
+ OP * const o2
+ = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", GV_ADD, SVt_PV)));
#endif /* USE_5005THREADS */
o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
}
@@ -2858,7 +2862,7 @@
if (expr->op_type == OP_CONST) {
STRLEN plen;
- SV *pat = ((SVOP*)expr)->op_sv;
+ SV * const pat = ((SVOP*)expr)->op_sv;
const char *p = SvPV_const(pat, plen);
if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) {
U32 was_readonly = SvREADONLY(pat);
@@ -2921,7 +2925,7 @@
if (repl) {
OP *curop;
if (pm->op_pmflags & PMf_EVAL) {
- curop = 0;
+ curop = NULL;
if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
CopLINE_set(PL_curcop, (line_t)PL_multi_end);
}
@@ -2947,7 +2951,7 @@
}
#else
if (curop->op_type == OP_GV) {
- GV *gv = cGVOPx_gv(curop);
+ GV * const gv = cGVOPx_gv(curop);
repl_has_vars = 1;
if (strchr("&`'123456789+-\016\022", *GvENAME(gv)))
break;
==== //depot/maint-5.8/perl/pad.c#54 (text) ====
Index: perl/pad.c
--- perl/pad.c#53~29141~ 2006-10-29 14:02:32.000000000 -0800
+++ perl/pad.c 2007-01-14 04:22:41.000000000 -0800
@@ -407,6 +407,7 @@
SV *sv;
I32 retval;
+ PERL_UNUSED_ARG(optype);
ASSERT_CURPAD_ACTIVE("pad_alloc");
if (AvARRAY(PL_comppad) != PL_curpad)
==== //depot/maint-5.8/perl/pp_ctl.c#136 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#135~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/pp_ctl.c 2007-01-14 04:22:41.000000000 -0800
@@ -206,7 +206,7 @@
SvLEN_set(targ, SvLEN(dstr));
if (DO_UTF8(dstr))
SvUTF8_on(targ);
- SvPV_set(dstr, (char*)0);
+ SvPV_set(dstr, NULL);
sv_free(dstr);
TAINT_IF(cx->sb_rxtainted & 1);
==== //depot/maint-5.8/perl/pp_hot.c#109 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#108~29794~ 2007-01-13 11:26:17.000000000 -0800
+++ perl/pp_hot.c 2007-01-14 04:22:41.000000000 -0800
@@ -121,10 +121,10 @@
if (PL_tainting && PL_tainted && !SvTAINTED(left))
TAINT_NOT;
if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
- SV *cv = SvRV(left);
+ SV * const cv = SvRV(left);
const U32 cv_type = SvTYPE(cv);
const U32 gv_type = SvTYPE(right);
- bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
+ const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
if (!got_coderef) {
assert(SvROK(cv));
@@ -135,7 +135,7 @@
context. */
if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
/* Is the target symbol table currently empty? */
- GV *gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
+ GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
/* Good. Create a new proxy constant subroutine in the target.
The gv becomes a(nother) reference to the constant. */
@@ -1117,10 +1117,8 @@
while (relem < lastrelem) { /* gobble up all the rest */
HE *didstore;
- if (*relem)
- sv = *(relem++);
- else
- sv = &PL_sv_no, relem++;
+ sv = *relem ? *relem : &PL_sv_no;
+ relem++;
tmpstr = NEWSV(29,0);
if (*relem)
sv_setsv(tmpstr,*relem); /* value */
@@ -1415,11 +1413,11 @@
}
if (global) {
if (dynpm->op_pmflags & PMf_CONTINUE) {
- MAGIC* mg = 0;
+ MAGIC* mg = NULL;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (!mg) {
- sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+ sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
mg = mg_find(TARG, PERL_MAGIC_regex_global);
}
if (rx->startp[0] != -1) {
@@ -1449,7 +1447,7 @@
else
mg = NULL;
if (!mg) {
- sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+ sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0);
mg = mg_find(TARG, PERL_MAGIC_regex_global);
}
if (rx->startp[0] != -1) {
@@ -1474,7 +1472,7 @@
if (RX_MATCH_COPIED(rx))
Safefree(rx->subbeg);
RX_MATCH_COPIED_off(rx);
- rx->subbeg = Nullch;
+ rx->subbeg = NULL;
if (global) {
/* FIXME - should rx->subbeg be const char *? */
rx->subbeg = (char *) truebase;
@@ -1510,7 +1508,7 @@
ret_no:
if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
- MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global);
+ MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (mg)
mg->mg_len = -1;
}
@@ -1532,22 +1530,24 @@
register IO * const io = GvIO(PL_last_in_gv);
register const I32 type = PL_op->op_type;
const I32 gimme = GIMME_V;
- MAGIC *mg;
- if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
- PUTBACK;
- ENTER;
- call_method("READLINE", gimme);
- LEAVE;
- SPAGAIN;
- if (gimme == G_SCALAR) {
- SV* result = POPs;
- SvSetSV_nosteal(TARG, result);
- PUSHTARG;
+ if (io) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ PUTBACK;
+ ENTER;
+ call_method("READLINE", gimme);
+ LEAVE;
+ SPAGAIN;
+ if (gimme == G_SCALAR) {
+ SV* const result = POPs;
+ SvSetSV_nosteal(TARG, result);
+ PUSHTARG;
+ }
+ RETURN;
}
- RETURN;
}
fp = NULL;
if (io) {
@@ -1674,11 +1674,10 @@
SPAGAIN;
XPUSHs(sv);
if (type == OP_GLOB) {
- char *tmps;
const char *t1;
if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
- tmps = SvEND(sv) - 1;
+ char * const tmps = SvEND(sv) - 1;
if (*tmps == *SvPVX_const(PL_rs)) {
*tmps = '\0';
SvCUR_set(sv, SvCUR(sv) - 1);
@@ -1776,7 +1775,7 @@
}
he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
- svp = he ? &HeVAL(he) : 0;
+ svp = he ? &HeVAL(he) : NULL;
}
else if (SvTYPE(hv) == SVt_PVAV) {
if (PL_op->op_private & OPpLVAL_INTRO)
@@ -1796,7 +1795,7 @@
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
- sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, Nullch, 0);
+ sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0);
SvREFCNT_dec(key2); /* sv_magic() increments refcount */
LvTARG(lv) = SvREFCNT_inc_simple(hv);
LvTARGLEN(lv) = 1;
@@ -2005,7 +2004,7 @@
lv = cx->blk_loop.iterlval = NEWSV(26, 0);
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
- sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0);
+ sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
}
LvTARG(lv) = SvREFCNT_inc_simple(av);
LvTARGOFF(lv) = cx->blk_loop.iterix;
@@ -2135,7 +2134,7 @@
}
}
else {
- c = Nullch;
+ c = NULL;
doutf8 = FALSE;
}
@@ -2296,7 +2295,7 @@
SvCUR_set(TARG, SvCUR(dstr));
SvLEN_set(TARG, SvLEN(dstr));
doutf8 |= DO_UTF8(dstr);
- SvPV_set(dstr, (char*)0);
+ SvPV_set(dstr, NULL);
sv_free(dstr);
TAINT_IF(rxtainted & 1);
@@ -2610,7 +2609,7 @@
SvREFCNT_dec(tmp);
}
else {
- gv_efullname3(dbsv, gv, Nullch);
+ gv_efullname3(dbsv, gv, NULL);
}
}
else {
@@ -2663,7 +2662,7 @@
mg_get(sv);
if (SvROK(sv))
goto got_rv;
- sym = SvPOKp(sv) ? SvPVX_const(sv) : Nullch;
+ sym = SvPOKp(sv) ? SvPVX_const(sv) : NULL;
}
else {
sym = SvPV_nolen_const(sv);
@@ -2720,7 +2719,7 @@
/* sorry */
else {
sub_name = sv_newmortal();
- gv_efullname3(sub_name, gv, Nullch);
+ gv_efullname3(sub_name, gv, NULL);
DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name);
}
}
@@ -3034,7 +3033,7 @@
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on
anonymous subroutine");
else {
SV* const tmpstr = sv_newmortal();
- gv_efullname3(tmpstr, CvGV(cv), Nullch);
+ gv_efullname3(tmpstr, CvGV(cv), NULL);
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on
subroutine \"%"SVf"\"",
tmpstr);
}
@@ -3079,7 +3078,7 @@
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
- sv_magic(lv, NULL, PERL_MAGIC_defelem, Nullch, 0);
+ sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
LvTARG(lv) = SvREFCNT_inc_simple(av);
LvTARGOFF(lv) = elem;
LvTARGLEN(lv) = 1;
@@ -3162,7 +3161,7 @@
GV* gv;
HV* stash;
STRLEN namelen;
- const char* packname = Nullch;
+ const char* packname = NULL;
SV *packsv = NULL;
STRLEN packlen;
const char * const name = SvPV_const(meth, namelen);
@@ -3253,7 +3252,7 @@
don't want that.
*/
const char* leaf = name;
- const char* sep = Nullch;
+ const char* sep = NULL;
const char* p;
for (p = name; *p; p++) {
==== //depot/maint-5.8/perl/pp_sys.c#120 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#119~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/pp_sys.c 2007-01-14 04:22:41.000000000 -0800
@@ -1985,8 +1985,6 @@
{
dSP;
GV *gv;
- IO *io;
- MAGIC *mg;
if (MAXARG == 0) {
if (PL_op->op_flags & OPf_SPECIAL) { /* eof() */
@@ -2011,17 +2009,19 @@
else
gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */
- if (gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
- {
- PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)io, mg));
- PUTBACK;
- ENTER;
- call_method("EOF", G_SCALAR);
- LEAVE;
- SPAGAIN;
- RETURN;
+ if (gv) {
+ IO * const io = GvIO(gv);
+ MAGIC * mg;
+ if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)io, mg));
+ PUTBACK;
+ ENTER;
+ call_method("EOF", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
}
PUSHs(boolSV(!gv || do_eof(gv)));
@@ -3546,7 +3546,7 @@
; e++)
{
/* you don't see this */
- char *errmsg =
+ const char * const errmsg =
#ifdef HAS_SYS_ERRLIST
sys_errlist[e]
#else
@@ -5192,18 +5192,16 @@
{
#ifdef HAS_GROUP
dSP;
- I32 which = PL_op->op_type;
- register char **elem;
- register SV *sv;
- struct group *grent;
+ const I32 which = PL_op->op_type;
+ const struct group *grent;
if (which == OP_GGRNAM) {
const char* const name = POPpbytex;
- grent = (struct group *)getgrnam(name);
+ grent = (const struct group *)getgrnam(name);
}
else if (which == OP_GGRGID) {
const Gid_t gid = POPi;
- grent = (struct group *)getgrgid(gid);
+ grent = (const struct group *)getgrgid(gid);
}
else
#ifdef HAS_GETGRENT
@@ -5214,7 +5212,9 @@
EXTEND(SP, 4);
if (GIMME != G_ARRAY) {
- PUSHs(sv = sv_newmortal());
+ SV * const sv = sv_newmortal();
+
+ PUSHs(sv);
if (grent) {
if (which == OP_GGRNAM)
sv_setiv(sv, (IV)grent->gr_gid);
@@ -5225,6 +5225,8 @@
}
if (grent) {
+ SV *sv;
+ char **elem;
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setpv(sv, grent->gr_name);
==== //depot/maint-5.8/perl/proto.h#153 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#152~29793~ 2007-01-13 10:59:04.000000000 -0800
+++ perl/proto.h 2007-01-14 04:22:41.000000000 -0800
@@ -1843,7 +1843,6 @@
STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor);
STATIC char* S_regcppop(pTHX);
-STATIC char* S_regcp_set_to(pTHX_ I32 ss);
STATIC void S_cache_re(pTHX_ regexp *prog);
STATIC U8* S_reghop(pTHX_ U8 *pos, I32 off)
__attribute__warn_unused_result__;
==== //depot/maint-5.8/perl/reentr.c#17 (text) ====
Index: perl/reentr.c
--- perl/reentr.c#16~25572~ 2005-09-22 09:46:28.000000000 -0700
+++ perl/reentr.c 2007-01-14 04:22:41.000000000 -0800
@@ -2,7 +2,7 @@
*
* reentr.c
*
- * Copyright (C) 2002, 2003, 2005 by Larry Wall and others
+ * Copyright (C) 2002, 2003, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
==== //depot/maint-5.8/perl/reentr.h#17 (text) ====
Index: perl/reentr.h
--- perl/reentr.h#16~25472~ 2005-09-18 08:52:39.000000000 -0700
+++ perl/reentr.h 2007-01-14 04:22:41.000000000 -0800
@@ -2,7 +2,7 @@
*
* reentr.h
*
- * Copyright (C) 2002, 2003, 2005 by Larry Wall and others
+ * Copyright (C) 2002, 2003, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
==== //depot/maint-5.8/perl/regcomp.c#76 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#75~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/regcomp.c 2007-01-14 04:22:41.000000000 -0800
@@ -282,27 +282,6 @@
} STMT_END
/*
- * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
- * args. Show regex, up to a maximum length. If it's too long, chop and add
- * "...".
- */
-#define FAIL2(pat,msg) STMT_START {
\
- const char *ellipses = ""; \
- IV len = RExC_end - RExC_precomp; \
- \
- if (!SIZE_ONLY) \
- SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
- if (len > RegexLengthToShowInErrorMessages) { \
- /* chop 10 shorter than the max, to ensure meaning of "..." */ \
- len = RegexLengthToShowInErrorMessages - 10; \
- ellipses = "..."; \
- } \
- S_re_croak2(aTHX_ pat, " in regex m/%.*s%s/", \
- msg, (int)len, RExC_precomp, ellipses); \
-} STMT_END
-
-
-/*
* Simple_vFAIL -- like FAIL, but marks the current location in the scan
*/
#define Simple_vFAIL(m) STMT_START {
\
@@ -979,7 +958,7 @@
if (flags & SCF_DO_SUBSTR)
scan_commit(pRExC_state, data);
if (UTF) {
- U8 *s = (U8 *)STRING(scan);
+ U8 * const s = (U8 *)STRING(scan);
l = utf8_length(s, s + l);
uc = utf8_to_uvchr(s, NULL);
}
@@ -2149,21 +2128,20 @@
register I32 parno = 0;
I32 flags;
const I32 oregflags = RExC_flags;
- I32 have_branch = 0;
- I32 open = 0;
+ bool have_branch = 0;
+ bool is_open = 0;
/* for (?g), (?gc), and (?o) warnings; warning
about (?c) will warn about (?g) -- japhy */
+#define WASTED_O 0x01
+#define WASTED_G 0x02
+#define WASTED_C 0x04
+#define WASTED_GC (0x02|0x04)
I32 wastedflags = 0x00;
- const I32 wasted_o = 0x01;
- const I32 wasted_g = 0x02;
- const I32 wasted_gc = 0x02 | 0x04;
- const I32 wasted_c = 0x04;
char * parse_start = RExC_parse; /* MJD */
char * const oregcomp_parse = RExC_parse;
- char c;
*flagp = 0; /* Tentatively. */
@@ -2173,7 +2151,7 @@
if (*RExC_parse == '?') { /* (?...) */
U32 posflags = 0, negflags = 0;
U32 *flagsp = &posflags;
- int logical = 0;
+ bool is_logical = 0;
const char * const seqstart = RExC_parse;
RExC_parse++;
@@ -2210,7 +2188,7 @@
vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
/* FALL THROUGH*/
case '?': /* (??...) */
- logical = 1;
+ is_logical = 1;
if (*RExC_parse != '{')
goto unknown;
paren = *RExC_parse++;
@@ -2220,32 +2198,28 @@
I32 count = 1, n = 0;
char c;
char *s = RExC_parse;
- SV *sv;
- OP_4tree *sop, *rop;
RExC_seen_zerolen++;
RExC_seen |= REG_SEEN_EVAL;
while (count && (c = *RExC_parse)) {
- if (c == '\\' && RExC_parse[1])
- RExC_parse++;
+ if (c == '\\') {
+ if (RExC_parse[1])
+ RExC_parse++;
+ }
else if (c == '{')
count++;
else if (c == '}')
count--;
RExC_parse++;
}
- if (*RExC_parse != ')')
- {
+ if (*RExC_parse != ')') {
RExC_parse = s;
vFAIL("Sequence (?{...}) not terminated or not
{}-balanced");
}
if (!SIZE_ONLY) {
PAD *pad;
-
- if (RExC_parse - 1 - s)
- sv = newSVpvn(s, RExC_parse - 1 - s);
- else
- sv = newSVpvs("");
+ OP_4tree *sop, *rop;
+ SV * const sv = newSVpvn(s, RExC_parse - 1 - s);
ENTER;
Perl_save_re_context(aTHX);
@@ -2272,7 +2246,7 @@
}
nextchar(pRExC_state);
- if (logical) {
+ if (is_logical) {
ret = reg_node(pRExC_state, LOGICAL);
if (!SIZE_ONLY)
ret->flags = 2;
@@ -2302,6 +2276,7 @@
}
else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
/* (?(1)...) */
+ char c;
parno = atoi(RExC_parse++);
while (isDIGIT(*RExC_parse))
@@ -2359,7 +2334,7 @@
if (*RExC_parse == 'o' || *RExC_parse == 'g') {
if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
- I32 wflagbit = *RExC_parse == 'o' ? wasted_o :
wasted_g;
+ const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O
: WASTED_G;
if (! (wastedflags & wflagbit) ) {
wastedflags |= wflagbit;
vWARN5(
@@ -2375,8 +2350,8 @@
}
else if (*RExC_parse == 'c') {
if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
- if (! (wastedflags & wasted_c) ) {
- wastedflags |= wasted_gc;
+ if (! (wastedflags & WASTED_C) ) {
+ wastedflags |= WASTED_GC;
vWARN3(
RExC_parse + 1,
"Useless (%sc) - %suse /gc modifier",
@@ -2419,7 +2394,7 @@
ret = reganode(pRExC_state, OPEN, parno);
Set_Node_Length(ret, 1); /* MJD */
Set_Node_Offset(ret, RExC_parse); /* MJD */
- open = 1;
+ is_open = 1;
}
}
else /* ! paren */
@@ -2448,7 +2423,7 @@
else if (paren == ':') {
*flagp |= flags&SIMPLE;
}
- if (open) { /* Starts with OPEN. */
+ if (is_open) { /* Starts with OPEN. */
regtail(pRExC_state, ret, br); /* OPEN -> first. */
}
else if (paren != '?') /* Not Conditional */
@@ -2770,7 +2745,7 @@
if (!SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3 &&
ckWARN(WARN_REGEXP)) {
vWARN3(RExC_parse,
"%.*s matches null string many times",
- RExC_parse - origparse,
+ (int)(RExC_parse >= origparse ? RExC_parse - origparse : 0),
origparse);
}
@@ -3768,12 +3743,16 @@
/* a bad range like a-\d, a-[:digit:] ? */
if (range) {
if (!SIZE_ONLY) {
- if (ckWARN(WARN_REGEXP))
+ if (ckWARN(WARN_REGEXP)) {
+ int w =
+ RExC_parse >= rangebegin ?
+ RExC_parse - rangebegin : 0;
vWARN4(RExC_parse,
"False [] range \"%*.*s\"",
- RExC_parse - rangebegin,
- RExC_parse - rangebegin,
+ w,
+ w,
rangebegin);
+ }
if (prevvalue < 256) {
ANYOF_BITMAP_SET(ret, prevvalue);
ANYOF_BITMAP_SET(ret, '-');
@@ -4177,12 +4156,16 @@
/* a bad range like \w-, [:word:]- ? */
if (namedclass > OOB_NAMEDCLASS) {
- if (ckWARN(WARN_REGEXP))
+ if (ckWARN(WARN_REGEXP)) {
+ int w =
+ RExC_parse >= rangebegin ?
+ RExC_parse - rangebegin : 0;
vWARN4(RExC_parse,
"False [] range \"%*.*s\"",
- RExC_parse - rangebegin,
- RExC_parse - rangebegin,
+ w,
+ w,
rangebegin);
+ }
if (!SIZE_ONLY)
ANYOF_BITMAP_SET(ret, '-');
} else
==== //depot/maint-5.8/perl/regexec.c#63 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#62~29794~ 2007-01-13 11:26:17.000000000 -0800
+++ perl/regexec.c 2007-01-14 04:22:41.000000000 -0800
@@ -281,17 +281,6 @@
return input;
}
-STATIC char *
-S_regcp_set_to(pTHX_ I32 ss)
-{
- const I32 tmp = PL_savestack_ix;
-
- PL_savestack_ix = ss;
- regcppop();
- PL_savestack_ix = tmp;
- return Nullch;
-}
-
typedef struct re_cc_state
{
I32 ss;
@@ -1185,8 +1174,7 @@
if (s == PL_bostr)
tmp = '\n';
else {
- U8 *r = reghop3((U8*)s, -1, (U8*)PL_bostr);
-
+ U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
}
tmp = ((OP(c) == BOUND ?
@@ -1228,8 +1216,7 @@
if (s == PL_bostr)
tmp = '\n';
else {
- U8 *r = reghop3((U8*)s, -1, (U8*)PL_bostr);
-
+ U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
}
tmp = ((OP(c) == NBOUND ?
@@ -1642,8 +1629,8 @@
const bool do_utf8 = DO_UTF8(sv);
const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
- SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
- SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
+ SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
+ SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
#endif
PERL_UNUSED_ARG(data);
RX_MATCH_UTF8_set(prog,do_utf8);
@@ -2320,9 +2307,9 @@
#endif
register const bool do_utf8 = PL_reg_match_utf8;
#ifdef DEBUGGING
- SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
- SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
- SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
+ SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
+ SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
+ SV * const dsv2 = PERL_DEBUG_PAD_ZERO(2);
#endif
U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
@@ -2336,7 +2323,7 @@
while (scan != NULL) {
DEBUG_r( {
- SV *prop = sv_newmortal();
+ SV * const prop = sv_newmortal();
const int docolor = *PL_colors[0];
const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol -
locinput);
@@ -2885,11 +2872,11 @@
case EVAL:
{
dSP;
- OP_4tree *oop = PL_op;
- COP *ocurcop = PL_curcop;
+ OP_4tree * const oop = PL_op;
+ COP * const ocurcop = PL_curcop;
PAD *old_comppad;
SV *ret;
- struct regexp *oreg = PL_reg_re;
+ struct regexp * const oreg = PL_reg_re;
n = ARG(scan);
PL_op = (OP_4tree*)PL_regdata->data[n];
@@ -2898,7 +2885,7 @@
PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
{
- SV **before = SP;
+ SV ** const before = SP;
CALLRUNOPS(aTHX); /* Scalar context. */
SPAGAIN;
if (SP == before)
@@ -2915,7 +2902,7 @@
if (logical) {
if (logical == 2) { /* Postponed subexpression. */
regexp *re;
- MAGIC *mg = Null(MAGIC*);
+ MAGIC *mg = NULL;
re_cc_state state;
CHECKPOINT cp, lastcp;
int toggleutf;
@@ -2936,7 +2923,7 @@
}
else {
STRLEN len;
- const char *t = SvPV_const(ret, len);
+ const char * const t = SvPV_const(ret, len);
PMOP pm;
char * const oprecomp = PL_regprecomp;
const I32 osize = PL_regsize;
@@ -3175,7 +3162,7 @@
CHECKPOINT cp, lastcp;
CURCUR* cc = PL_regcc;
- char *lastloc = cc->lastloc; /* Detection of 0-len. */
+ char * const lastloc = cc->lastloc; /* Detection of 0-len. */
I32 cache_offset = 0, cache_bit = 0;
n = cc->cur + 1; /* how many we know we matched */
@@ -3379,12 +3366,10 @@
next = inner; /* Avoid recursion. */
else {
const I32 lastparen = *PL_reglastparen;
- I32 unwind1;
- re_unwind_branch_t *uw;
-
/* Put unwinding data on stack */
- unwind1 = SSNEWt(1,re_unwind_branch_t);
- uw = SSPTRt(unwind1,re_unwind_branch_t);
+ const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
+ re_unwind_branch_t * const uw =
SSPTRt(unwind1,re_unwind_branch_t);
+
uw->prev = unwind;
unwind = unwind1;
uw->type = ((c1 == BRANCH)
@@ -3833,14 +3818,22 @@
re_cc_state *cur_call_cc = PL_reg_call_cc;
CURCUR *cctmp = PL_regcc;
regexp *re = PL_reg_re;
- CHECKPOINT cp, lastcp;
-
- cp = regcppush(0); /* Save *all* the positions. */
+ CHECKPOINT lastcp;
+ I32 tmp;
+
+ /* Save *all* the positions. */
+ const CHECKPOINT cp = regcppush(0);
REGCP_SET(lastcp);
- regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
- the caller. */
- PL_reginput = locinput; /* Make position available to
- the callcc. */
+
+ /* Restore parens of the caller. */
+ tmp = PL_savestack_ix;
+ PL_savestack_ix = PL_reg_call_cc->ss;
+ regcppop();
+ PL_savestack_ix = tmp;
+
+ /* Make position available to the callcc. */
+ PL_reginput = locinput;
+
cache_re(PL_reg_call_cc->re);
PL_regcc = PL_reg_call_cc->cc;
PL_reg_call_cc = PL_reg_call_cc->prev;
@@ -3979,13 +3972,13 @@
no_final:
do_no:
if (unwind) {
- re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
+ re_unwind_t * const uw = SSPTRt(unwind,re_unwind_t);
switch (uw->type) {
case RE_UNWIND_BRANCH:
case RE_UNWIND_BRANCHJ:
{
- re_unwind_branch_t *uwb = &(uw->branch);
+ re_unwind_branch_t * const uwb = &(uw->branch);
const I32 lastparen = uwb->lastparen;
REGCP_UNWIND(uwb->lastcp);
@@ -4266,7 +4259,7 @@
DEBUG_r(
{
- SV *prop = sv_newmortal();
+ SV * const prop = sv_newmortal();
regprop(prop, (regnode *)p);
PerlIO_printf(Perl_debug_log,
==== //depot/maint-5.8/perl/sv.c#278 (text) ====
Index: perl/sv.c
--- perl/sv.c#277~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/sv.c 2007-01-14 04:22:41.000000000 -0800
@@ -1124,7 +1124,8 @@
IoPAGE_LEN(sv) = 60;
break;
default:
- Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", new_type);
+ Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
+ (unsigned long)new_type);
}
if (old_type_details->size) {
@@ -3263,7 +3264,7 @@
SvTEMP_off(dstr);
(void)SvOK_off(sstr); /* NOTE: nukes most SvFLAGS on sstr */
- SvPV_set(sstr, Nullch);
+ SvPV_set(sstr, NULL);
SvLEN_set(sstr, 0);
SvCUR_set(sstr, 0);
SvTEMP_off(sstr);
@@ -8679,8 +8680,8 @@
#define io_dup_inc(s,t) (IO*)SvREFCNT_inc(sv_dup((SV*)s,t))
#define gv_dup(s,t) (GV*)sv_dup((SV*)s,t)
#define gv_dup_inc(s,t) (GV*)SvREFCNT_inc(sv_dup((SV*)s,t))
-#define SAVEPV(p) (p ? savepv(p) : Nullch)
-#define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch)
+#define SAVEPV(p) ((p) ? savepv(p) : NULL)
+#define SAVEPVN(p,n) ((p) ? savepvn(p,n) : NULL)
/* Duplicate a regexp. Required reading: pregcomp() and pregfree() in
@@ -9107,7 +9108,7 @@
if (SvTYPE(dstr) == SVt_RV)
SvRV_set(dstr, NULL);
else
- SvPV_set(dstr, 0);
+ SvPV_set(dstr, NULL);
}
}
@@ -9119,7 +9120,7 @@
SV *dstr;
if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
- return Nullsv;
+ return NULL;
/* look for it in the table first */
dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr);
if (dstr)
@@ -10678,7 +10679,7 @@
* orphaned
*/
for (i = 0; i<= proto_perl->Ttmps_ix; i++) {
- SV *nsv = (SV*)ptr_table_fetch(PL_ptr_table,
+ SV * const nsv = (SV*)ptr_table_fetch(PL_ptr_table,
proto_perl->Ttmps_stack[i]);
if (nsv && !SvREFCNT(nsv)) {
EXTEND_MORTAL(1);
==== //depot/maint-5.8/perl/toke.c#127 (text) ====
Index: perl/toke.c
--- perl/toke.c#126~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/toke.c 2007-01-14 04:22:41.000000000 -0800
@@ -857,6 +857,9 @@
for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++) ;
if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
+
+ /* XXX Things like this are just so nasty. We shouldn't be modifying
+ source code, even if we realquick set it back. */
if (ckWARN_d(WARN_AMBIGUOUS)){
const char ch = *s;
*s = '\0';
@@ -9175,15 +9178,13 @@
STATIC char *
S_scan_ident(pTHX_ register char *s, register const char *send, char *dest,
STRLEN destlen, I32 ck_uni)
{
- register char *d;
- register char *e;
- char *bracket = Nullch;
+ char *bracket = NULL;
char funny = *s++;
+ register char *d = dest;
+ register char * const e = d + destlen + 3; /* two-character token,
ending NUL */
if (isSPACE(*s))
s = skipspace(s);
- d = dest;
- e = d + destlen - 3; /* two-character token, ending NUL */
if (isDIGIT(*s)) {
while (isDIGIT(*s)) {
if (d >= e)
@@ -9258,15 +9259,15 @@
if (isIDFIRST_lazy_if(d,UTF)) {
d++;
if (UTF) {
- e = s;
- while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
- e += UTF8SKIP(e);
- while (e < send && UTF8_IS_CONTINUED(*e) &&
is_utf8_mark((U8*)e))
- e += UTF8SKIP(e);
- }
- Copy(s, d, e - s, char);
- d += e - s;
- s = e;
+ char *end = s;
+ while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':')
{
+ end += UTF8SKIP(end);
+ while (end < send && UTF8_IS_CONTINUED(*end) &&
is_utf8_mark((U8*)end))
+ end += UTF8SKIP(end);
+ }
+ Copy(s, d, end - s, char);
+ d += end - s;
+ s = end;
}
else {
while ((isALNUM(*s) || *s == ':') && d < e)
@@ -9353,9 +9354,10 @@
{
PMOP *pm;
char *s = scan_str(start,FALSE,FALSE);
+ const char * const valid_flags = (type == OP_QR) ? "iomsx" : "iogcmsx";
if (!s) {
- char * const delimiter = skipspace(start);
+ const char * const delimiter = skipspace(start);
Perl_croak(aTHX_ *delimiter == '?'
? "Search pattern not terminated or ternary operator parsed
as search pattern"
: "Search pattern not terminated" );
@@ -9364,14 +9366,8 @@
pm = (PMOP*)newPMOP(type, 0);
if (PL_multi_open == '?')
pm->op_pmflags |= PMf_ONCE;
- if(type == OP_QR) {
- while (*s && strchr("iomsx", *s))
- pmflag(&pm->op_pmflags,*s++);
- }
- else {
- while (*s && strchr("iogcmsx", *s))
- pmflag(&pm->op_pmflags,*s++);
- }
+ while (*s && strchr(valid_flags, *s))
+ pmflag(&pm->op_pmflags,*s++);
/* issue a warning if /c is specified,but /g is not */
if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
&& ckWARN(WARN_REGEXP))
@@ -9432,12 +9428,12 @@
}
if (es) {
- SV *repl;
+ SV * const repl = newSVpvs("");
+
PL_sublex_info.super_bufptr = s;
PL_sublex_info.super_bufend = PL_bufend;
PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
- repl = newSVpvs("");
while (es-- > 0)
sv_catpv(repl, es ? "eval " : "do ");
sv_catpvs(repl, "{ ");
@@ -9605,8 +9601,8 @@
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
- char *bufptr = PL_sublex_info.super_bufptr;
- char *bufend = PL_sublex_info.super_bufend;
+ char * const bufptr = PL_sublex_info.super_bufptr;
+ char * const bufend = PL_sublex_info.super_bufend;
char * const olds = s - SvCUR(herewas);
s = strchr(bufptr, '\n');
if (!s)
@@ -9678,7 +9674,7 @@
PL_bufend[-1] = '\n';
#endif
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(88,0);
+ SV * const sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
@@ -9736,13 +9732,12 @@
S_scan_inputsymbol(pTHX_ char *start)
{
register char *s = start; /* current position in buffer */
- register char *d;
- const char *e;
char *end;
I32 len;
- d = PL_tokenbuf; /* start of temp holding space */
- e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */
+ char *d = PL_tokenbuf; /* start of
temp holding space */
+ const char * const e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp
holding space */
+
end = strchr(s, '\n');
if (!end)
end = PL_bufend;
@@ -9788,7 +9783,7 @@
}
else {
bool readline_overriden = FALSE;
- GV *gv_readline = Nullgv;
+ GV *gv_readline;
GV **gvp;
/* we're in a filehandle read situation */
d = PL_tokenbuf;
@@ -9798,7 +9793,8 @@
Copy("ARGV",d,5,char);
/* Check whether readline() is overriden */
- if (((gv_readline = gv_fetchpv("readline", 0, SVt_PVCV))
+ gv_readline = gv_fetchpv("readline", 0, SVt_PVCV);
+ if ((gv_readline
&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
||
((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
@@ -9817,7 +9813,7 @@
*/
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
- SV *sym = sv_2mortal(
+ SV * const sym = sv_2mortal(
newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),0));
sv_catpvs(sym, "::");
sv_catpv(sym, d+1);
@@ -9825,7 +9821,7 @@
goto intro_sym;
}
else {
- OP *o = newOP(OP_PADSV, 0);
+ OP * const o = newOP(OP_PADSV, 0);
o->op_targ = tmp;
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -9861,7 +9857,7 @@
/* If it's none of the above, it must be a literal filehandle
(<Foo::BAR> or <FOO>) so build a simple readline OP */
else {
- GV *gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
+ GV * const gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
@@ -9983,8 +9979,8 @@
int offset = s - SvPVX_const(PL_linestr);
const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr,
&offset, (char*)termstr, termlen);
- const char *ns = SvPVX_const(PL_linestr) + offset;
- char *svlast = SvEND(sv) - 1;
+ const char * const ns = SvPVX_const(PL_linestr) + offset;
+ char * const svlast = SvEND(sv) - 1;
for (; s < ns; s++) {
if (*s == '\n' && !PL_rsfp)
@@ -10549,7 +10545,7 @@
if (!floatit) {
UV uv;
- int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
+ const int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv);
if (flags == IS_NUMBER_IN_UV) {
if (uv <= IV_MAX)
@@ -10604,7 +10600,7 @@
{
register char *eol;
register char *t;
- SV *stuff = newSVpvs("");
+ SV * const stuff = newSVpvs("");
bool needargs = FALSE;
bool eofmt = FALSE;
@@ -10706,7 +10702,7 @@
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
const I32 oldsavestack_ix = PL_savestack_ix;
- CV* outsidecv = PL_compcv;
+ CV* const outsidecv = PL_compcv;
if (PL_compcv) {
assert(SvTYPE(PL_compcv) == SVt_PVCV);
@@ -10804,7 +10800,7 @@
where = "within string";
}
else {
- SV *where_sv = sv_2mortal(newSVpvs("next char "));
+ SV * const where_sv = sv_2mortal(newSVpvs("next char "));
if (yychar < 32)
Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
else if (isPRINT_LC(yychar))
==== //depot/maint-5.8/perl/uconfig.sh#15 (xtext) ====
Index: perl/uconfig.sh
--- perl/uconfig.sh#14~28443~ 2006-06-27 15:39:26.000000000 -0700
+++ perl/uconfig.sh 2007-01-14 04:22:41.000000000 -0800
@@ -47,6 +47,8 @@
d_attribute_pure='undef'
d_attribute_unused='undef'
d_attribute_warn_unused_result='undef'
+d_builtin_expect='undef'
+d_builtin_choose_expr='undef'
d_bcmp='undef'
d_bcopy='undef'
d_bsd='undef'
End of Patch.
