void
Perl_av_extend(pTHX_ AV *av, I32 key)
{
- MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
+ MAGIC * const mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied);
+ if (mg) {
dSP;
ENTER;
SAVETMPS;
while (tmp)
ary[--tmp] = &PL_sv_undef;
}
-
if (key > AvMAX(av) - 10) {
newmax = key + AvMAX(av);
goto resize;
if (tied_magic && key < 0) {
/* Handle negative array indices 20020222 MJD */
- SV **negative_indices_glob =
+ SV * const * const negative_indices_glob =
hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
tied_magic))),
NEGATIVE_INDICES_VAR, 16, 0);
/* Handle negative array indices 20020222 MJD */
if (key < 0) {
unsigned adjust_index = 1;
- SV **negative_indices_glob =
+ SV * const * const negative_indices_glob =
hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
tied_magic))),
NEGATIVE_INDICES_VAR, 16, 0);
AV *
Perl_newAV(pTHX)
{
- register AV *av;
+ register AV * const av = (AV*)NEWSV(3,0);
- av = (AV*)NEWSV(3,0);
sv_upgrade((SV *)av, SVt_PVAV);
/* sv_upgrade does AvREAL_only() */
AvALLOC(av) = 0;
AV *
Perl_av_make(pTHX_ register I32 size, register SV **strp)
{
- register AV *av;
+ register AV * const av = (AV*)NEWSV(8,0);
- av = (AV*)NEWSV(8,0);
sv_upgrade((SV *) av,SVt_PVAV);
/* sv_upgrade does AvREAL_only() */
if (size) { /* "defined" was returning undef for size==0 anyway. */
AV *
Perl_av_fake(pTHX_ register I32 size, register SV **strp)
{
- register AV *av;
register SV** ary;
+ register AV * const av = (AV*)NEWSV(9,0);
- av = (AV*)NEWSV(9,0);
sv_upgrade((SV *)av, SVt_PVAV);
Newx(ary,size+1,SV*);
AvALLOC(av) = ary;
return;
if (AvREAL(av)) {
- SV** ary = AvARRAY(av);
+ SV** const ary = AvARRAY(av);
key = AvFILLp(av) + 1;
while (key) {
- SV * sv = ary[--key];
+ SV * const sv = ary[--key];
/* undef the slot before freeing the value, because a
* destructor might try to modify this arrray */
ary[key] = &PL_sv_undef;
if (key < 0) {
unsigned adjust_index = 1;
if (tied_magic) {
- SV **negative_indices_glob =
+ SV * const * const negative_indices_glob =
hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
tied_magic))),
NEGATIVE_INDICES_VAR, 16, 0);
if (key < 0) {
unsigned adjust_index = 1;
if (tied_magic) {
- SV **negative_indices_glob =
+ SV * const * const negative_indices_glob =
hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av,
tied_magic))),
NEGATIVE_INDICES_VAR, 16, 0);
/* NOTE: No support for tied ISA */
I32 items = AvFILLp(av) + 1;
while (items--) {
- SV* sv = *svp++;
- HV* basestash = gv_stashsv(sv, FALSE);
+ SV* const sv = *svp++;
+ HV* const basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
/* if at top level, try UNIVERSAL */
if (level == 0 || level == -1) {
- HV* lastchance;
+ HV* const lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE);
- if ((lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE))) {
+ if (lastchance) {
if ((gv = gv_fetchmeth(lastchance, name, len,
(level >= 0) ? level + 1 : level - 1)))
{
SV *
Perl_hv_scalar(pTHX_ HV *hv)
{
- MAGIC *mg;
SV *sv;
-
- if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
- sv = magic_scalarpack(hv, mg);
- return sv;
- }
+
+ if (SvRMAGICAL(hv)) {
+ MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+ if (mg)
+ return magic_scalarpack(hv, mg);
+ }
sv = sv_newmortal();
if (HvFILL((HV*)hv))
if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
}
- else if (isUPPER(mg->mg_type)) {
- sv_magic(nsv,
- mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) :
- (mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj)
- ? sv : mg->mg_obj,
- toLOWER(mg->mg_type), key, klen);
- count++;
+ else {
+ const char type = mg->mg_type;
+ if (isUPPER(type)) {
+ sv_magic(nsv,
+ (type == PERL_MAGIC_tied)
+ ? SvTIED_obj(sv, mg)
+ : (type == PERL_MAGIC_regdata && mg->mg_obj)
+ ? sv
+ : mg->mg_obj,
+ toLOWER(type), key, klen);
+ count++;
+ }
}
}
return count;
register char *s = NULL;
register I32 i;
register REGEXP *rx;
+ const char * const remaining = mg->mg_ptr + 1;
+ const char nextchar = *remaining;
switch (*mg->mg_ptr) {
case '\001': /* ^A */
sv_setsv(sv, PL_bodytarget);
break;
case '\003': /* ^C, ^CHILD_ERROR_NATIVE */
- if (*(mg->mg_ptr+1) == '\0') {
+ if (nextchar == '\0') {
sv_setiv(sv, (IV)PL_minus_c);
}
- else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+ else if (strEQ(remaining, "HILD_ERROR_NATIVE")) {
sv_setiv(sv, (IV)STATUS_NATIVE);
}
break;
sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
break;
case '\005': /* ^E */
- if (*(mg->mg_ptr+1) == '\0') {
+ if (nextchar == '\0') {
#ifdef MACOS_TRADITIONAL
{
char msg[256];
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
if (errno != errno_isOS2) {
- int tmp = _syserrno();
+ const int tmp = _syserrno();
if (tmp) /* 2nd call to _syserrno() makes it 0 */
Perl_rc = tmp;
}
{
DWORD dwErr = GetLastError();
sv_setnv(sv, (NV)dwErr);
- if (dwErr)
- {
+ if (dwErr) {
PerlProc_GetOSError(sv, dwErr);
}
else
SvRTRIM(sv);
SvNOK_on(sv); /* what a wonderful hack! */
}
- else if (strEQ(mg->mg_ptr+1, "NCODING"))
+ else if (strEQ(remaining, "NCODING"))
sv_setsv(sv, PL_encoding);
break;
case '\006': /* ^F */
sv_setsv(sv, &PL_sv_undef);
break;
case '\017': /* ^O & ^OPEN */
- if (*(mg->mg_ptr+1) == '\0') {
+ if (nextchar == '\0') {
sv_setpv(sv, PL_osname);
SvTAINTED_off(sv);
}
- else if (strEQ(mg->mg_ptr, "\017PEN")) {
+ else if (strEQ(remaining, "PEN")) {
if (!PL_compiling.cop_io)
sv_setsv(sv, &PL_sv_undef);
else {
sv_setiv(sv, (IV)PL_perldb);
break;
case '\023': /* ^S */
- if (*(mg->mg_ptr+1) == '\0') {
+ if (nextchar == '\0') {
if (PL_lex_state != LEX_NOTPARSING)
SvOK_off(sv);
else if (PL_in_eval)
}
break;
case '\024': /* ^T */
- if (*(mg->mg_ptr+1) == '\0') {
+ if (nextchar == '\0') {
#ifdef BIG_TIME
sv_setnv(sv, PL_basetime);
#else
sv_setiv(sv, (IV)PL_basetime);
#endif
}
- else if (strEQ(mg->mg_ptr, "\024AINT"))
+ else if (strEQ(remaining, "AINT"))
sv_setiv(sv, PL_tainting
? (PL_taint_warn || PL_unsafe ? -1 : 1)
: 0);
break;
case '\025': /* $^UNICODE, $^UTF8LOCALE */
- if (strEQ(mg->mg_ptr, "\025NICODE"))
+ if (strEQ(remaining, "NICODE"))
sv_setuv(sv, (UV) PL_unicode);
- else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+ else if (strEQ(remaining, "TF8LOCALE"))
sv_setuv(sv, (UV) PL_utf8locale);
break;
case '\027': /* ^W & $^WARNING_BITS */
- if (*(mg->mg_ptr+1) == '\0')
+ if (nextchar == '\0')
sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
- else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
+ else if (strEQ(remaining, "ARNING_BITS")) {
if (PL_compiling.cop_warnings == pWARN_NONE) {
sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
}
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
SV **bits_all;
- HV *bits=get_hv("warnings::Bits", FALSE);
+ HV * const bits=get_hv("warnings::Bits", FALSE);
if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
sv_setsv(sv, *bits_all);
}
SvUTF8_off(sv);
if (PL_tainting) {
if (RX_MATCH_TAINTED(rx)) {
- MAGIC* mg = SvMAGIC(sv);
+ MAGIC* const mg = SvMAGIC(sv);
MAGIC* mgt;
PL_tainted = 1;
SvMAGIC_set(sv, mg->mg_moremagic);
? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
: (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
{
- SV *targ = cx->sb_targ;
+ SV * const targ = cx->sb_targ;
assert(cx->sb_strend >= s);
if(cx->sb_strend > s) {
PP(pp_formline)
{
dSP; dMARK; dORIGMARK;
- register SV *tmpForm = *++MARK;
+ register SV * const tmpForm = *++MARK;
register U32 *fpc;
register char *t;
const char *f;
NV value;
bool gotsome = FALSE;
STRLEN len;
- STRLEN fudge = SvPOK(tmpForm)
+ const STRLEN fudge = SvPOK(tmpForm)
? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
bool item_is_utf8 = FALSE;
bool targ_is_utf8 = FALSE;
else {
SV * const final = sv_mortalcopy(right);
STRLEN len;
- const char *tmps = SvPV_const(final, len);
+ const char * const tmps = SvPV_const(final, len);
SV *sv = sv_mortalcopy(left);
SvPV_force_nolen(sv);
&& (gv = (GV*)*svp) ))) {
/* Use GV from the stack as a fallback. */
/* GV is potentially non-unique, or contain different CV. */
- SV *tmp = newRV((SV*)cv);
+ SV * const tmp = newRV((SV*)cv);
sv_setsv(dbsv, tmp);
SvREFCNT_dec(tmp);
}
}
got_rv:
{
- SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */
+ SV * const * sp = &sv; /* Used in tryAMAGICunDEREF macro. */
tryAMAGICunDEREF(to_cv);
}
cv = (CV*)SvRV(sv);
static void
do_clean_objs(pTHX_ SV *ref)
{
- SV* target;
-
- if (SvROK(ref) && SvOBJECT(target = SvRV(ref))) {
- DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(ref)));
- if (SvWEAKREF(ref)) {
- sv_del_backref(target, ref);
- SvWEAKREF_off(ref);
- SvRV_set(ref, NULL);
- } else {
- SvROK_off(ref);
- SvRV_set(ref, NULL);
- SvREFCNT_dec(target);
+ if (SvROK(ref)) {
+ SV * const target = SvRV(ref);
+ if (SvOBJECT(target)) {
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(ref)));
+ if (SvWEAKREF(ref)) {
+ sv_del_backref(target, ref);
+ SvWEAKREF_off(ref);
+ SvRV_set(ref, NULL);
+ } else {
+ SvROK_off(ref);
+ SvRV_set(ref, NULL);
+ SvREFCNT_dec(target);
+ }
}
}
S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
{
char *ptr = buf + TYPE_CHARS(UV);
- char *ebuf = ptr;
+ char * const ebuf = ptr;
int sign;
if (is_uv)
return (char *)"";
}
{
- STRLEN len = s - SvPVX_const(sv);
+ const STRLEN len = s - SvPVX_const(sv);
if (lp)
*lp = len;
SvCUR_set(sv, len);
if (sflags & SVf_ROK) {
if (dtype >= SVt_PV) {
if (dtype == SVt_PVGV) {
- SV *sref = SvREFCNT_inc(SvRV(sstr));
+ SV * const sref = SvREFCNT_inc(SvRV(sstr));
SV *dref = 0;
const int intro = GvINTRO(dstr);
else
dref = (SV*)GvCV(dstr);
if (GvCV(dstr) != (CV*)sref) {
- CV* cv = GvCV(dstr);
+ CV* const cv = GvCV(dstr);
if (cv) {
if (!GvCVGEN((GV*)dstr) &&
(CvROOT(cv) || CvXSUB(cv)))
default:
SvGETMAGIC(sv);
if (SvROK(sv)) {
- SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */
+ SV * const *sp = &sv; /* Used in tryAMAGICunDEREF macro. */
tryAMAGICunDEREF(to_cv);
sv = SvRV(sv);
if (!sv)
return 0;
if (SvPOK(sv)) {
- register const XPV* tXpv;
- if ((tXpv = (XPV*)SvANY(sv)) &&
+ register const XPV* const tXpv = (XPV*)SvANY(sv);
+ if (tXpv &&
(tXpv->xpv_cur > 1 ||
(tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))
return 1;
Perl_sv_tainted(pTHX_ SV *sv)
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
- MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
+ const MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
if (mg && (mg->mg_len & 1) )
return TRUE;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff