From: Andy Lester Date: Mon, 9 Jan 2006 23:42:43 +0000 (-0600) Subject: It's the Barbie bus patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6136c704e4e88f5381eda30a0d872d75aa9b9d11;p=p5sagit%2Fp5-mst-13.2.git It's the Barbie bus patch Message-ID: <20060110054243.GA26165@petdance.com> p4raw-id: //depot/perl@26764 --- diff --git a/av.c b/av.c index 42e1887..19aeffb 100644 --- a/av.c +++ b/av.c @@ -367,7 +367,7 @@ Perl_newAV(pTHX) 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; } @@ -482,7 +482,7 @@ Perl_av_undef(pTHX_ register AV *av) } Safefree(AvALLOC(av)); AvALLOC(av) = 0; - SvPV_set(av, (char*)0); + SvPV_set(av, NULL); AvMAX(av) = AvFILLp(av) = -1; } diff --git a/doio.c b/doio.c index 1dc4169..8474465 100644 --- a/doio.c +++ b/doio.c @@ -1381,7 +1381,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, #else if (sp > mark) { char **a; - const char *tmps = Nullch; + const char *tmps = NULL; Newx(PL_Argv, sp - mark + 1, char*); a = PL_Argv; @@ -1391,7 +1391,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, else *a++ = ""; } - *a = Nullch; + *a = NULL; if (really) tmps = SvPV_nolen_const(really); if ((!really && *PL_Argv[0] != '/') || @@ -1544,7 +1544,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (*s) *s++ = '\0'; } - *a = Nullch; + *a = NULL; if (PL_Argv[0]) { PERL_FPU_PRE_EXEC PerlProc_execvp(PL_Argv[0],PL_Argv); @@ -1553,15 +1553,13 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) 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(); diff --git a/embed.fnc b/embed.fnc index b54969d..dfe412d 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1278,7 +1278,6 @@ ERs |bool |reginclass |NN const regnode *n|NN const U8 *p|NULLOK STRLEN *lenp\ |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 diff --git a/embed.h b/embed.h index f359500..88804de 100644 --- a/embed.h +++ b/embed.h @@ -1303,7 +1303,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 @@ -3343,7 +3342,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) diff --git a/gv.c b/gv.c index 42c1556..7ebf280 100644 --- a/gv.c +++ b/gv.c @@ -435,20 +435,20 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le 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; @@ -1458,9 +1458,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) 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", @@ -1484,7 +1484,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) /* 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\ diff --git a/hv.c b/hv.c index 69bbdcf..f12f117 100644 --- a/hv.c +++ b/hv.c @@ -447,8 +447,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, 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(); @@ -553,7 +552,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* 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; @@ -596,7 +595,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* 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; @@ -696,7 +695,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* 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; @@ -920,13 +919,14 @@ SV * 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); } @@ -958,7 +958,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, register HE *entry; register HE **oentry; HE *const *first_entry; - SV *sv; bool is_utf8; int masked_flags; @@ -981,6 +980,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, 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, Nullsv, hash); @@ -1051,6 +1051,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; 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) @@ -1067,13 +1068,12 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } /* 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"); @@ -1368,8 +1368,9 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) 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])) @@ -1433,7 +1434,7 @@ Perl_newHVhv(pTHX_ HV *ohv) /* In each bucket... */ for (i = 0; i <= hv_max; i++) { - HE *prev = NULL, *ent = NULL; + HE *prev = NULL; HE *oent = oents[i]; if (!oent) { @@ -1447,8 +1448,8 @@ Perl_newHVhv(pTHX_ HV *ohv) 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) @@ -1557,7 +1558,7 @@ Perl_hv_clear(pTHX_ HV *hv) /* 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); @@ -1615,7 +1616,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv) i = HvMAX(hv); do { /* Loop down the linked list heads */ - bool first = 1; + bool first = TRUE; HE **oentry = &(HvARRAY(hv))[i]; HE *entry; @@ -1639,7 +1640,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv) } } else { oentry = &HeNEXT(entry); - first = 0; + first = FALSE; } } } while (--i >= 0); @@ -1680,7 +1681,7 @@ S_hfreeentries(pTHX_ HV *hv) /* This is the one we're going to try to empty. First time round it's the original array. (Hopefully there will only be 1 time round) */ - HE **array = HvARRAY(hv); + HE ** const array = HvARRAY(hv); I32 i = HvMAX(hv); /* Because we have taken xhv_name out, the only allocated pointer @@ -1770,7 +1771,7 @@ S_hfreeentries(pTHX_ HV *hv) if (--attempts == 0) { Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries"); } - }; + } HvARRAY(hv) = orig_array; @@ -1866,7 +1867,7 @@ Perl_hv_iterinit(pTHX_ HV *hv) Perl_croak(aTHX_ "Bad hash"); if (SvOOK(hv)) { - struct xpvhv_aux *iter = HvAUX(hv); + struct xpvhv_aux * const iter = HvAUX(hv); HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ HvLAZYDEL_off(hv); @@ -1875,7 +1876,7 @@ Perl_hv_iterinit(pTHX_ HV *hv) iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */ } else { - S_hv_auxinit(aTHX_ hv); + hv_auxinit(hv); } /* used to be xhv->xhv_fill before 5.004_65 */ @@ -1889,7 +1890,7 @@ Perl_hv_riter_p(pTHX_ HV *hv) { if (!hv) Perl_croak(aTHX_ "Bad hash"); - iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv); + iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); return &(iter->xhv_riter); } @@ -1900,7 +1901,7 @@ Perl_hv_eiter_p(pTHX_ HV *hv) { if (!hv) Perl_croak(aTHX_ "Bad hash"); - iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv); + iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); return &(iter->xhv_eiter); } @@ -1917,7 +1918,7 @@ Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) { if (riter == -1) return; - iter = S_hv_auxinit(aTHX_ hv); + iter = hv_auxinit(hv); } iter->xhv_riter = riter; } @@ -1937,7 +1938,7 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) { if (!eiter) return; - iter = S_hv_auxinit(aTHX_ hv); + iter = hv_auxinit(hv); } iter->xhv_eiter = eiter; } @@ -1960,7 +1961,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags) if (name == 0) return; - iter = S_hv_auxinit(aTHX_ hv); + iter = hv_auxinit(hv); } PERL_HASH(hash, name, len); iter->xhv_name = name ? share_hek(name, len, hash) : 0; @@ -1968,9 +1969,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags) AV ** Perl_hv_backreferences_p(pTHX_ HV *hv) { - struct xpvhv_aux *iter; - - iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv); + struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); return &(iter->xhv_backreferences); } diff --git a/mg.c b/mg.c index d6e7667..3e3ebfd 100644 --- a/mg.c +++ b/mg.c @@ -643,7 +643,8 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) #define SvRTRIM(sv) STMT_START { \ STRLEN len = SvCUR(sv); \ - while (len > 0 && isSPACE(SvPVX(sv)[len-1])) \ + char * const p = SvPVX(sv); \ + while (len > 0 && isSPACE(p[len-1])) \ --len; \ SvCUR_set(sv, len); \ } STMT_END @@ -1257,7 +1258,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) 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); @@ -1964,12 +1965,11 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) 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; } diff --git a/op.c b/op.c index 20c0831..09f269a 100644 --- a/op.c +++ b/op.c @@ -792,9 +792,10 @@ Perl_scalarvoid(pTHX_ OP *o) 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; } } @@ -1582,13 +1583,12 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) ; /* 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, @@ -1617,7 +1617,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) 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. */ stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; @@ -1682,7 +1682,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv, } Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, - newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1), + newSVpvs(ATTRSMODULE), Nullsv, prepend_elem(OP_LIST, newSVOP(OP_CONST, 0, newSVpv(stashpv,0)), prepend_elem(OP_LIST, @@ -2055,8 +2055,7 @@ OP * Perl_jmaybe(pTHX_ OP *o) { if (o->op_type == OP_LIST) { - OP *o2; - 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))); o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o)); } return o; @@ -2827,7 +2826,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) 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); @@ -2895,7 +2894,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) 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); } @@ -2906,7 +2905,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) { if (PL_opargs[curop->op_type] & OA_DANGEROUS) { 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; diff --git a/pad.c b/pad.c index d13cd75..3ab7497 100644 --- a/pad.c +++ b/pad.c @@ -411,6 +411,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) SV *sv; I32 retval; + PERL_UNUSED_ARG(optype); ASSERT_CURPAD_ACTIVE("pad_alloc"); if (AvARRAY(PL_comppad) != PL_curpad) diff --git a/pp_ctl.c b/pp_ctl.c index 05b34bf..193f0e2 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -244,7 +244,7 @@ PP(pp_substcont) 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); diff --git a/pp_hot.c b/pp_hot.c index c48333a..38ad000 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -123,10 +123,10 @@ PP(pp_sassign) 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)); @@ -137,7 +137,7 @@ PP(pp_sassign) 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. */ @@ -401,11 +401,12 @@ PP(pp_or) PP(pp_defined) { dVAR; dSP; - register SV* sv = NULL; - bool defined = FALSE; + register SV* sv; + bool defined; const int op_type = PL_op->op_type; + const int is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN); - if(op_type == OP_DOR || op_type == OP_DORASSIGN) { + if (is_dor) { sv = TOPs; if (!sv || !SvANY(sv)) { if (op_type == OP_DOR) @@ -419,6 +420,7 @@ PP(pp_defined) } else DIE(aTHX_ "panic: Invalid op (%s) in pp_defined()", OP_NAME(PL_op)); + defined = FALSE; switch (SvTYPE(sv)) { case SVt_PVAV: if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) @@ -436,9 +438,10 @@ PP(pp_defined) SvGETMAGIC(sv); if (SvOK(sv)) defined = TRUE; + break; } - - if(op_type == OP_DOR || op_type == OP_DORASSIGN) { + + if (is_dor) { if(defined) RETURN; if(op_type == OP_DOR) @@ -1105,10 +1108,8 @@ PP(pp_aassign) 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 */ @@ -1400,11 +1401,11 @@ play_it_again: } 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) { @@ -1434,7 +1435,7 @@ play_it_again: 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) { @@ -1459,7 +1460,7 @@ yup: /* Confirmed by INTUIT */ 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; @@ -1513,7 +1514,7 @@ nope: 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; } @@ -1535,22 +1536,24 @@ Perl_do_readline(pTHX) 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 = Nullfp; if (io) { @@ -1677,11 +1680,10 @@ Perl_do_readline(pTHX) 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); @@ -1779,7 +1781,7 @@ PP(pp_helem) } he = hv_fetch_ent(hv, keysv, lval && !defer, hash); - svp = he ? &HeVAL(he) : 0; + svp = he ? &HeVAL(he) : NULL; } else { RETPUSHUNDEF; @@ -1794,7 +1796,7 @@ PP(pp_helem) 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(hv); LvTARGLEN(lv) = 1; @@ -2000,7 +2002,7 @@ PP(pp_iter) 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(av); LvTARGOFF(lv) = cx->blk_loop.iterix; @@ -2143,7 +2145,7 @@ PP(pp_subst) } } else { - c = Nullch; + c = NULL; doutf8 = FALSE; } @@ -2329,7 +2331,7 @@ PP(pp_subst) 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); @@ -2654,7 +2656,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) SvREFCNT_dec(tmp); } else { - gv_efullname3(dbsv, gv, Nullch); + gv_efullname3(dbsv, gv, NULL); } } else { @@ -2707,7 +2709,7 @@ PP(pp_entersub) 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); @@ -2764,7 +2766,7 @@ try_autoload: /* 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); } } @@ -2924,7 +2926,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) 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); } @@ -2969,7 +2971,7 @@ PP(pp_aelem) lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0); + sv_magic(lv, Nullsv, PERL_MAGIC_defelem, NULL, 0); LvTARG(lv) = SvREFCNT_inc(av); LvTARGOFF(lv) = elem; LvTARGLEN(lv) = 1; @@ -3053,7 +3055,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) GV* gv; HV* stash; STRLEN namelen; - const char* packname = Nullch; + const char* packname = NULL; SV *packsv = Nullsv; STRLEN packlen; const char * const name = SvPV_const(meth, namelen); @@ -3144,7 +3146,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) don't want that. */ const char* leaf = name; - const char* sep = Nullch; + const char* sep = NULL; const char* p; for (p = name; *p; p++) { diff --git a/pp_sys.c b/pp_sys.c index e1c6125..fa5c59e 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1932,8 +1932,6 @@ PP(pp_eof) { dVAR; dSP; GV *gv; - IO *io; - MAGIC *mg; if (MAXARG == 0) { if (PL_op->op_flags & OPf_SPECIAL) { /* eof() */ @@ -1958,17 +1956,19 @@ PP(pp_eof) 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))); @@ -3543,7 +3543,7 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) ; e++) { /* you don't see this */ - char *errmsg = + const char * const errmsg = #ifdef HAS_SYS_ERRLIST sys_errlist[e] #else @@ -5194,18 +5194,16 @@ PP(pp_ggrent) { #ifdef HAS_GROUP dVAR; 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 @@ -5216,7 +5214,9 @@ PP(pp_ggrent) 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); @@ -5227,6 +5227,8 @@ PP(pp_ggrent) } if (grent) { + SV *sv; + char **elem; PUSHs(sv = sv_mortalcopy(&PL_sv_no)); sv_setpv(sv, grent->gr_name); diff --git a/proto.h b/proto.h index 3bd2ced..d94b93a 100644 --- a/proto.h +++ b/proto.h @@ -3594,7 +3594,6 @@ STATIC bool S_reginclass(pTHX_ const regnode *n, const U8 *p, STRLEN *lenp, bool 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) __attribute__nonnull__(pTHX_1); diff --git a/reentr.c b/reentr.c index 0657791..4dcaf80 100644 --- a/reentr.c +++ b/reentr.c @@ -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. diff --git a/reentr.h b/reentr.h index 9ee49a4..ca526c4 100644 --- a/reentr.h +++ b/reentr.h @@ -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. diff --git a/regcomp.c b/regcomp.c index 86b9140..12bfc1c 100644 --- a/regcomp.c +++ b/regcomp.c @@ -282,27 +282,6 @@ static const scan_data_t zero_scan_data = } 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 { \ @@ -765,7 +744,7 @@ and would end up looking like: DEBUG_TRIE_COMPILE_r({ \ SV *tmp; \ if ( UTF ) { \ - tmp = newSVpvn( "", 0 ); \ + tmp = newSVpvs( "" ); \ pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX ); \ } else { \ tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc ); \ @@ -2051,7 +2030,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, if (flags & SCF_DO_SUBSTR) scan_commit(pRExC_state, data); if (UTF) { - U8 *s = (U8 *)STRING(scan); + const U8 * const s = (U8 *)STRING(scan); l = utf8_length(s, s + l); uc = utf8_to_uvchr(s, NULL); } @@ -3222,21 +3201,20 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) 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. */ @@ -3246,7 +3224,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) 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++; @@ -3283,7 +3261,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})"); /* FALL THROUGH*/ case '?': /* (??...) */ - logical = 1; + is_logical = 1; if (*RExC_parse != '{') goto unknown; paren = *RExC_parse++; @@ -3293,32 +3271,28 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) 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); @@ -3347,7 +3321,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) } nextchar(pRExC_state); - if (logical) { + if (is_logical) { ret = reg_node(pRExC_state, LOGICAL); if (!SIZE_ONLY) ret->flags = 2; @@ -3377,6 +3351,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) } else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) { /* (?(1)...) */ + char c; parno = atoi(RExC_parse++); while (isDIGIT(*RExC_parse)) @@ -3434,7 +3409,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) 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( @@ -3450,8 +3425,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) } 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", @@ -3494,7 +3469,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) 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 */ @@ -3523,7 +3498,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) 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 */ diff --git a/regexec.c b/regexec.c index a65ded7..7ca4667 100644 --- a/regexec.c +++ b/regexec.c @@ -285,18 +285,6 @@ S_regcppop(pTHX) return input; } -STATIC char * -S_regcp_set_to(pTHX_ I32 ss) -{ - dVAR; - const I32 tmp = PL_savestack_ix; - - PL_savestack_ix = ss; - regcppop(); - PL_savestack_ix = tmp; - return Nullch; -} - typedef struct re_cc_state { I32 ss; @@ -1193,8 +1181,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 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 ? @@ -1236,8 +1223,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 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 ? @@ -1651,8 +1637,8 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * const bool do_utf8 = DO_UTF8(sv); const I32 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 GET_RE_DEBUG_FLAGS_DECL; @@ -2417,9 +2403,9 @@ S_regmatch(pTHX_ regnode *prog) #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); SV *re_debug_flags = NULL; #endif @@ -2438,7 +2424,7 @@ S_regmatch(pTHX_ regnode *prog) while (scan != NULL) { DEBUG_EXECUTE_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); @@ -2762,7 +2748,7 @@ S_regmatch(pTHX_ regnode *prog) best = cur; } DEBUG_EXECUTE_r({ - SV **tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 ); + SV ** const tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 ); PerlIO_printf( Perl_debug_log, "%*s %strying alternation #%d <%s> at 0x%p%s\n", REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], accept_buff[best].wordnum, @@ -3204,11 +3190,11 @@ S_regmatch(pTHX_ regnode *prog) 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]; @@ -3217,7 +3203,7 @@ S_regmatch(pTHX_ regnode *prog) 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) @@ -3234,7 +3220,7 @@ S_regmatch(pTHX_ regnode *prog) 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; @@ -3255,7 +3241,7 @@ S_regmatch(pTHX_ regnode *prog) } 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; @@ -3494,7 +3480,7 @@ S_regmatch(pTHX_ regnode *prog) 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 */ @@ -3698,12 +3684,10 @@ S_regmatch(pTHX_ regnode *prog) 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) @@ -4152,14 +4136,22 @@ S_regmatch(pTHX_ regnode *prog) 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; @@ -4298,13 +4290,13 @@ no: 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); @@ -4586,7 +4578,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) DEBUG_r({ SV *re_debug_flags = NULL; - SV *prop = sv_newmortal(); + SV * const prop = sv_newmortal(); GET_RE_DEBUG_FLAGS; DEBUG_EXECUTE_r({ regprop(prop, p); diff --git a/sv.c b/sv.c index b2cd1d8..72412f7 100644 --- a/sv.c +++ b/sv.c @@ -1090,14 +1090,14 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) /* Could put this in the else clause below, as PVMG must have SvPVX 0 already (the assertion above) */ - SvPV_set(sv, (char*)0); + SvPV_set(sv, NULL); if (old_type >= SVt_PVMG) { SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_magic); SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash); } else { - SvMAGIC_set(sv, 0); - SvSTASH_set(sv, 0); + SvMAGIC_set(sv, NULL); + SvSTASH_set(sv, NULL); } break; @@ -1149,7 +1149,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) if (new_type == SVt_PVIO) IoPAGE_LEN(sv) = 60; if (old_type < SVt_RV) - SvPV_set(sv, 0); + SvPV_set(sv, NULL); break; default: Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", @@ -3394,7 +3394,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) 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); @@ -3781,7 +3781,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) SvFAKE_off(sv); SvREADONLY_off(sv); /* This SV doesn't own the buffer, so need to Newx() a new one: */ - SvPV_set(sv, (char*)0); + SvPV_set(sv, NULL); SvLEN_set(sv, 0); if (flags & SV_COW_DROP_PV) { /* OK, so we don't need to copy our buffer. */ @@ -8939,8 +8939,8 @@ ptr_table_* functions. #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 @@ -9372,7 +9372,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param) if (SvTYPE(dstr) == SVt_RV) SvRV_set(dstr, NULL); else - SvPV_set(dstr, 0); + SvPV_set(dstr, NULL); } } @@ -9385,7 +9385,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) 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) @@ -10851,7 +10851,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, * 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); diff --git a/toke.c b/toke.c index 139a121..d539b07 100644 --- a/toke.c +++ b/toke.c @@ -878,6 +878,9 @@ S_check_uni(pTHX) 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'; @@ -9384,15 +9387,13 @@ STATIC char * S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni) { dVAR; - 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) @@ -9467,15 +9468,15 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL 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); + 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, e - s, char); - d += e - s; - s = e; + Copy(s, d, end - s, char); + d += end - s; + s = end; } else { while ((isALNUM(*s) || *s == ':') && d < e) @@ -9563,9 +9564,10 @@ S_scan_pat(pTHX_ char *start, I32 type) dVAR; 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" ); @@ -9574,14 +9576,8 @@ S_scan_pat(pTHX_ char *start, I32 type) 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)) @@ -9643,12 +9639,12 @@ S_scan_subst(pTHX_ char *start) } 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, "{ "); @@ -9819,8 +9815,8 @@ S_scan_heredoc(pTHX_ register char *s) 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) @@ -9892,7 +9888,7 @@ S_scan_heredoc(pTHX_ register char *s) 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); @@ -9951,13 +9947,12 @@ S_scan_inputsymbol(pTHX_ char *start) { dVAR; 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; @@ -10003,7 +9998,7 @@ S_scan_inputsymbol(pTHX_ char *start) } else { bool readline_overriden = FALSE; - GV *gv_readline = Nullgv; + GV *gv_readline; GV **gvp; /* we're in a filehandle read situation */ d = PL_tokenbuf; @@ -10013,7 +10008,8 @@ S_scan_inputsymbol(pTHX_ char *start) 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_fetch(PL_globalstash, "readline", 8, FALSE)) @@ -10032,16 +10028,16 @@ S_scan_inputsymbol(pTHX_ char *start) */ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { - HV *stash = PAD_COMPNAME_OURSTASH(tmp); - HEK *stashname = HvNAME_HEK(stash); - SV *sym = sv_2mortal(newSVhek(stashname)); + HV * const stash = PAD_COMPNAME_OURSTASH(tmp); + HEK * const stashname = HvNAME_HEK(stash); + SV * const sym = sv_2mortal(newSVhek(stashname)); sv_catpvs(sym, "::"); sv_catpv(sym, d+1); d = SvPVX(sym); 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, @@ -10077,7 +10073,7 @@ intro_sym: /* If it's none of the above, it must be a literal filehandle ( or ) 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, @@ -10200,8 +10196,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) 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) @@ -10767,7 +10763,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) 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) @@ -10820,7 +10816,7 @@ S_scan_formline(pTHX_ register char *s) dVAR; register char *eol; register char *t; - SV *stuff = newSVpvs(""); + SV * const stuff = newSVpvs(""); bool needargs = FALSE; bool eofmt = FALSE; @@ -10924,7 +10920,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { dVAR; 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); @@ -11014,7 +11010,7 @@ Perl_yyerror(pTHX_ const char *s) 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)) diff --git a/uconfig.sh b/uconfig.sh index af4ce9a..af4c297 100755 --- a/uconfig.sh +++ b/uconfig.sh @@ -47,6 +47,8 @@ d_attribute_noreturn='undef' 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' diff --git a/util.c b/util.c index 48cc63a..c503dda 100644 --- a/util.c +++ b/util.c @@ -929,7 +929,7 @@ S_mess_alloc(pTHX) Newxz(any, 1, XPVMG); SvFLAGS(sv) = SVt_PVMG; SvANY(sv) = (void*)any; - SvPV_set(sv, 0); + SvPV_set(sv, NULL); SvREFCNT(sv) = 1 << 30; /* practically infinite */ PL_mess_sv = sv; return sv;