#define POPSTACK \
STMT_START { \
dSP; \
- PERL_SI *prev = PL_curstackinfo->si_prev; \
+ PERL_SI * const prev = PL_curstackinfo->si_prev; \
if (!prev) { \
PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
my_exit(1); \
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
STRLEN len;
- const short *tbl = (short*)cPVOP->op_pv;
+ const short * const tbl = (short*)cPVOP->op_pv;
if (!tbl)
Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
const I32 ch = tbl[*s];
if (ch >= 0) {
matches++;
- *s++ = (U8)ch;
+ *s = (U8)ch;
}
- else
- s++;
+ s++;
}
SvSETMAGIC(sv);
return matches;
SV* const rv = (SV*)cSVOP->op_sv;
HV* const hv = (HV*)SvRV(rv);
- SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV* const * svp = hv_fetch(hv, "NONE", 4, FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
UV final = 0;
s = (U8*)SvPV(sv, len);
isutf8 = SvUTF8(sv);
if (!isutf8) {
- const U8 *t = s, *e = s + len;
+ const U8 *t = s;
+ const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
if ((hibit = !NATIVE_IS_INVARIANT(ch)))
SV* const rv = (SV*)cSVOP->op_sv;
HV* const hv = (HV*)SvRV(rv);
- SV** const svp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV* const * const svp = hv_fetch(hv, "NONE", 4, FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
U8 hibit = 0;
s = (const U8*)SvPV_const(sv, len);
if (!SvUTF8(sv)) {
const U8 *t = s;
- const U8 *e = s + len;
+ const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
if ((hibit = !NATIVE_IS_INVARIANT(ch)))
send = s + len;
while (s < send) {
- UV uv;
- if ((uv = swash_fetch(rv, s, TRUE)) < none || uv == extra)
+ const UV uv = swash_fetch(rv, s, TRUE);
+ if (uv < none || uv == extra)
matches++;
s += UTF8SKIP(s);
}
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
SV * const rv = (SV*)cSVOP->op_sv;
HV * const hv = (HV*)SvRV(rv);
- SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV * const *svp = hv_fetch(hv, "NONE", 4, FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
UV final = 0;
void
Perl_do_vecset(pTHX_ SV *sv)
{
- SV *targ = LvTARG(sv);
register I32 offset;
register I32 size;
register unsigned char *s;
I32 mask;
STRLEN targlen;
STRLEN len;
+ SV * const targ = LvTARG(sv);
if (!targ)
return;
if (SvTYPE(sv) == SVt_PVAV) {
register I32 i;
- AV* av = (AV*)sv;
+ AV* const av = (AV*)sv;
const I32 max = AvFILL(av);
for (i = 0; i <= max; i++) {
return;
}
else if (SvTYPE(sv) == SVt_PVHV) {
- HV* hv = (HV*)sv;
+ HV* const hv = (HV*)sv;
HE* entry;
(void)hv_iterinit(hv);
while ((entry = hv_iternext(hv)))
s = SvPV_force(sv, len);
if (DO_UTF8(sv)) {
if (s && len) {
- char *send = s + len;
+ char * const send = s + len;
char *start = s;
s = send - 1;
while (s > start && UTF8_IS_CONTINUATION(*s))
(void)SvPOK_only(sv);
if (left_utf || right_utf) {
UV duc, luc, ruc;
- char *dcsave = dc;
+ char * const dcsave = dc;
STRLEN lulen = leftlen;
STRLEN rulen = rightlen;
STRLEN ulen;
Perl_do_kv(pTHX)
{
dSP;
- HV *hv = (HV*)POPs;
+ HV * const hv = (HV*)POPs;
HV *keys;
register HE *entry;
const I32 gimme = GIMME_V;
oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
- SV *key = sv_newmortal();
+ SV * const key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
{
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
if (HeKLEN(entry) == HEf_SVKEY)
mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
else
#ifdef USE_LOCALE_NUMERIC
if (PL_numeric_radix_sv && IN_LOCALE) {
STRLEN len;
- const char* radix = SvPV(PL_numeric_radix_sv, len);
+ const char * const radix = SvPV(PL_numeric_radix_sv, len);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
- const char *send = pv + len;
+ const char * const send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
#if ((defined(VMS) && !defined(__IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
STMT_START {
- NV exp_v = log10(value);
+ const NV exp_v = log10(value);
if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
return NV_MAX;
if (exponent < 0) {
const char *tname = (name ? name : aname);
if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(0,0);
- SV *tmpstr = sv_newmortal();
+ SV * const sv = NEWSV(0,0);
+ SV * const tmpstr = sv_newmortal();
GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
HV *hv;
*/
{
I32 i = AvFILLp(PL_regex_padav) + 1;
- SV **ary = AvARRAY(PL_regex_padav);
+ SV * const * const ary = AvARRAY(PL_regex_padav);
while (i) {
- SV *resv = ary[--i];
+ SV * const resv = ary[--i];
if (SvFLAGS(resv) & SVf_BREAK) {
/* this is PL_reg_curpm, already freed
*/
I32 riter = 0;
const I32 max = HvMAX(PL_strtab);
- HE ** const array = HvARRAY(PL_strtab);
+ HE * const * const array = HvARRAY(PL_strtab);
HE *hent = array[0];
for (;;) {
*/
const char *space;
- char *pv = SvPV_nolen(opts_prog);
+ char * const pv = SvPV_nolen(opts_prog);
const char c = pv[opts+76];
pv[opts+76] = '\0';
space = strrchr(pv+opts+26, ' ');
AV*
Perl_get_av(pTHX_ const char *name, I32 create)
{
- GV* gv = gv_fetchpv(name, create, SVt_PVAV);
+ GV* const gv = gv_fetchpv(name, create, SVt_PVAV);
if (create)
return GvAVn(gv);
if (gv)
CV*
Perl_get_cv(pTHX_ const char *name, I32 create)
{
- GV* gv = gv_fetchpv(name, create, SVt_PVCV);
+ GV* const gv = gv_fetchpv(name, create, SVt_PVCV);
/* XXX unsafe for threads if eval_owner isn't held */
/* XXX this is probably not what they think they're getting.
* It has the same effect as "sub name;", i.e. just a forward
I32 oldscope;
bool oldcatch = CATCH_GET;
int ret;
- OP* oldop = PL_op;
+ OP* const oldop = PL_op;
dJMPENV;
if (flags & G_DISCARD) {
volatile I32 oldmark = SP - PL_stack_base;
volatile I32 retval = 0;
int ret;
- OP* oldop = PL_op;
+ OP* const oldop = PL_op;
dJMPENV;
if (flags & G_DISCARD) {
void
Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
{
- register GV *gv;
+ register GV * const gv = gv_fetchpv(sym,TRUE, SVt_PV);
- if ((gv = gv_fetchpv(sym,TRUE, SVt_PV)))
+ if (gv)
sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
}
static const char debopts[] = "psltocPmfrxu HXDSTRJvCAq";
for (; isALNUM(**s); (*s)++) {
- const char *d = strchr(debopts,**s);
+ const char * const d = strchr(debopts,**s);
if (d)
i |= 1 << (d - debopts);
else if (ckWARN_d(WARN_DEBUGGING))
in the fashion that -MSome::Mod does. */
if (*s == ':' || *s == '=') {
const char *start;
- SV *sv;
- sv = newSVpv("use Devel::", 0);
+ SV * const sv = newSVpv("use Devel::", 0);
start = ++s;
/* We now allow -d:Module=Foo,Bar */
while(isALNUM(*s) || *s==':') ++s;
}
#else /* IAMSUID */
else if (PL_preprocess) {
- const char *cpp_cfg = CPPSTDIN;
- SV *cpp = newSVpvn("",0);
- SV *cmd = NEWSV(0,0);
+ const char * const cpp_cfg = CPPSTDIN;
+ SV * const cpp = newSVpvn("",0);
+ SV * const cmd = NEWSV(0,0);
if (cpp_cfg[0] == 0) /* PERL_MICRO? */
Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
void
Perl_init_debugger(pTHX)
{
- HV *ostash = PL_curstash;
+ HV * const ostash = PL_curstash;
PL_curstash = PL_debstash;
PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("DB::args", GV_ADDMULTI, SVt_PVAV))));
if (addsubdirs || addoldvers) {
#ifdef PERL_INC_VERSION_LIST
/* Configure terminates PERL_INC_VERSION_LIST with a NULL */
- const char *incverlist[] = { PERL_INC_VERSION_LIST };
- const char **incver;
+ const char * const incverlist[] = { PERL_INC_VERSION_LIST };
+ const char * const *incver;
#endif
#ifdef VMS
char *unix;
}
if (PL_perlio_debug_fd > 0) {
dTHX;
- const char *s = CopFILE(PL_curcop);
STRLEN len;
+ const char *s = CopFILE(PL_curcop);
#ifdef USE_ITHREADS
/* Use fixed buffer as sv_catpvf etc. needs SVs */
char buffer[1024];
if (!s)
s = "(none)";
- len = sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
+ len = my_sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
vsprintf(buffer+len, fmt, ap);
PerlLIO_write(PL_perlio_debug_fd, buffer, strlen(buffer));
#else
- SV *sv = newSVpvn("", 0);
+ SV * const sv = newSVpvn("", 0);
if (!s)
s = "(none)";
Perl_sv_catpvf(aTHX_ sv, "%s:%" IVdf " ", s,
IV
PerlIOStdio_fileno(pTHX_ PerlIO *f)
{
- FILE *s;
- if (PerlIOValid(f) && (s = PerlIOSelf(f, PerlIOStdio)->stdio)) {
- return PerlSIO_fileno(s);
+ if (PerlIOValid(f)) {
+ FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
+ if (s)
+ return PerlSIO_fileno(s);
}
errno = EBADF;
return -1;
IV
PerlIOStdio_close(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (!stdio) {
errno = EBADF;
return -1;
SSize_t
PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
- FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
SSize_t got = 0;
for (;;) {
if (count == 1) {
PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
SSize_t unread = 0;
- FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
#ifdef STDIO_BUFFER_WRITABLE
if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) {
IV
PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_fseek(stdio, offset, whence);
}
Off_t
PerlIOStdio_tell(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_ftell(stdio);
}
IV
PerlIOStdio_flush(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
return PerlSIO_fflush(stdio);
}
STDCHAR *
PerlIOStdio_get_base(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return (STDCHAR*)PerlSIO_get_base(stdio);
}
Size_t
PerlIOStdio_get_bufsiz(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_get_bufsiz(stdio);
}
#endif
STDCHAR *
PerlIOStdio_get_ptr(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return (STDCHAR*)PerlSIO_get_ptr(stdio);
}
SSize_t
PerlIOStdio_get_cnt(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
return PerlSIO_get_cnt(stdio);
}
void
PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (ptr != NULL) {
#ifdef STDIO_PTR_LVALUE
PerlSIO_set_ptr(stdio, (void*)ptr); /* LHS STDCHAR* cast non-portable */
IV
PerlIOStdio_fill(pTHX_ PerlIO *f)
{
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
int c;
/*
* fflush()ing read-only streams can cause trouble on some stdio-s
SvREFCNT_dec(sv);
}
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
- FILE *stdio = PerlSIO_tmpfile();
+ FILE * const stdio = PerlSIO_tmpfile();
if (stdio) {
if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
PERLIO_FUNCS_CAST(&PerlIO_stdio),
"w+", Nullsv))) {
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+ PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
if (s)
s->stdio = stdio;
dTHX;
if (SvOK(pos)) {
STRLEN len;
- Off_t *posn = (Off_t *) SvPV(pos, len);
+ const Off_t * const posn = (Off_t *) SvPV(pos, len);
if (f && len == sizeof(Off_t))
return PerlIO_seek(f, *posn, SEEK_SET);
}
dTHX;
if (SvOK(pos)) {
STRLEN len;
- Fpos_t *fpos = (Fpos_t *) SvPV(pos, len);
+ Fpos_t * const fpos = (Fpos_t *) SvPV(pos, len);
if (f && len == sizeof(Fpos_t)) {
#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
return fsetpos64(f, fpos);
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
* will be enough to hold an OP*.
*/
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
sv_upgrade(sv, SVt_PVLV);
LvTYPE(sv) = '/';
Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
PP(pp_qr)
{
dSP;
- register PMOP *pm = cPMOP;
- SV *rv = sv_newmortal();
- SV *sv = newSVrv(rv, "Regexp");
+ register PMOP * const pm = cPMOP;
+ SV * const rv = sv_newmortal();
+ SV * const sv = newSVrv(rv, "Regexp");
if (pm->op_pmdynflags & PMdf_TAINTED)
SvTAINTED_on(rv);
sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
/* All done yet? */
if (PL_stack_base + *PL_markstack_ptr > SP) {
I32 items;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
LEAVE; /* exit outer scope */
(void)POPMARK; /* pop src */
SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
if (PL_op->op_private & OPpGREP_LEX) {
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
sv_setiv(sv, items);
PUSHs(sv);
}
STATIC int
S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
{
- Uid_t ruid = getuid();
- Uid_t euid = geteuid();
- Gid_t rgid = getgid();
- Gid_t egid = getegid();
+ const Uid_t ruid = getuid();
+ const Uid_t euid = geteuid();
+ const Gid_t rgid = getgid();
+ const Gid_t egid = getegid();
int res;
LOCK_CRED_MUTEX;
dVAR; dSP;
dMARK; dORIGMARK;
dTARGET;
- GV *gv;
SV *sv;
IO *io;
const char *tmps;
STRLEN len;
- MAGIC *mg;
bool ok;
- gv = (GV *)*++MARK;
+ GV * const gv = (GV *)*++MARK;
+
if (!isGV(gv))
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv)))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
- if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
- /* Method's args are same as ours ... */
- /* ... except handle is replaced by the object */
- *MARK-- = SvTIED_obj((SV*)io, mg);
- PUSHMARK(MARK);
- PUTBACK;
- ENTER;
- call_method("OPEN", G_SCALAR);
- LEAVE;
- SPAGAIN;
- RETURN;
+ if (io) {
+ MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ /* Method's args are same as ours ... */
+ /* ... except handle is replaced by the object */
+ *MARK-- = SvTIED_obj((SV*)io, mg);
+ PUSHMARK(MARK);
+ PUTBACK;
+ ENTER;
+ call_method("OPEN", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ RETURN;
+ }
}
if (MARK < SP) {
PP(pp_close)
{
dVAR; dSP;
- GV *gv;
IO *io;
MAGIC *mg;
-
- if (MAXARG == 0)
- gv = PL_defoutgv;
- else
- gv = (GV*)POPs;
+ GV * const gv = (MAXARG == 0) ? PL_defoutgv : (GV*)POPs;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
{
#ifdef HAS_PIPE
dSP;
- GV *rgv;
- GV *wgv;
register IO *rstio;
register IO *wstio;
int fd[2];
- wgv = (GV*)POPs;
- rgv = (GV*)POPs;
+ GV * const wgv = (GV*)POPs;
+ GV * const rgv = (GV*)POPs;
if (!rgv || !wgv)
goto badexit;
PP(pp_tie)
{
dVAR; dSP; dMARK;
- SV *varsv;
HV* stash;
GV *gv;
SV *sv;
const char *methname;
int how = PERL_MAGIC_tied;
U32 items;
+ SV *varsv = *++MARK;
- varsv = *++MARK;
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
- GV *gv;
CV *cv = NULL;
if (obj) {
- if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
- isGV(gv) && (cv = GvCV(gv))) {
+ GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
+ if (gv && isGV(gv) && (cv = GvCV(gv))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
Perl_warner(aTHX_ packWARN(WARN_UNTIE),
"untie attempted while %"UVuf" inner references still exist",
(UV)SvREFCNT(obj) - 1 ) ;
- }
+ }
}
}
sv_unmagic(sv, how) ;
dPOPPOPssrl;
HV* stash;
GV *gv;
- SV *sv;
HV * const hv = (HV*)POPs;
+ SV * const sv = sv_mortalcopy(&PL_sv_no);
- sv = sv_mortalcopy(&PL_sv_no);
sv_setpv(sv, "AnyDBM_File");
stash = gv_stashsv(sv, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
SP -= 4;
for (i = 1; i <= 3; i++) {
- SV *sv = SP[i];
+ SV * const sv = SP[i];
if (!SvOK(sv))
continue;
if (SvREADONLY(sv)) {
if (! hv)
XPUSHs(&PL_sv_undef);
else {
- GV ** const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+ GV * const * const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
if (gvp && *gvp == egv) {
gv_efullname4(TARG, PL_defoutgv, Nullch, TRUE);
XPUSHTARG;
PP(pp_prtf)
{
dVAR; dSP; dMARK; dORIGMARK;
- GV *gv;
IO *io;
PerlIO *fp;
SV *sv;
MAGIC *mg;
- if (PL_op->op_flags & OPf_STACKED)
- gv = (GV*)*++MARK;
- else
- gv = PL_defoutgv;
+ GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
IO *io;
MAGIC *mg;
- if (MAXARG == 0)
- gv = PL_last_in_gv;
- else
- gv = PL_last_in_gv = (GV*)POPs;
+ if (MAXARG != 0)
+ PL_last_in_gv = (GV*)POPs;
+ gv = PL_last_in_gv;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
}
tsv = NEWSV(0,0);
if (SvOBJECT(sv)) {
- const char *name = HvNAME_get(SvSTASH(sv));
+ const char * const name = HvNAME_get(SvSTASH(sv));
Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
name ? name : "__ANON__" , typestr, PTR2UV(sv));
}
* chars in the PV. Given that there isn't such a flag
* make the loop as fast as possible. */
const U8 *s = (U8 *) SvPVX_const(sv);
- const U8 *e = (U8 *) SvEND(sv);
+ const U8 * const e = (U8 *) SvEND(sv);
const U8 *t = s;
int hibit = 0;
&& (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)
&& ckWARN(WARN_PRINTF))
{
- SV *msg = sv_newmortal();
+ SV * const msg = sv_newmortal();
Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
(PL_op->op_type == OP_PRTF) ? "" : "s");
if (c) {
STATIC void
S_printbuf(pTHX_ const char* fmt, const char* s)
{
- SV* tmp = newSVpvn("", 0);
+ SV* const tmp = newSVpvn("", 0);
PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
SvREFCNT_dec(tmp);
}
*t = '\0';
if (t - s > 0) {
#ifndef USE_ITHREADS
- const char *cf = CopFILE(PL_curcop);
+ const char * const cf = CopFILE(PL_curcop);
if (cf && strlen(cf) > 7 && strnEQ(cf, "(eval ", 6)) {
/* must copy *{"::_<(eval N)[oldfilename:L]"}
* to *{"::_<newfilename"} */
/* 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_SYNTAX),
XS(XS_UNIVERSAL_isa)
{
dXSARGS;
- SV *sv;
- const char *name;
if (items != 2)
Perl_croak(aTHX_ "Usage: UNIVERSAL::isa(reference, kind)");
+ else {
+ SV * const sv = ST(0);
+ const char *name;
- sv = ST(0);
-
- SvGETMAGIC(sv);
+ SvGETMAGIC(sv);
- if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
- || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
- XSRETURN_UNDEF;
+ if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
+ || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
+ XSRETURN_UNDEF;
- name = SvPV_nolen_const(ST(1));
+ name = SvPV_nolen_const(ST(1));
- ST(0) = boolSV(sv_derived_from(sv, name));
- XSRETURN(1);
+ ST(0) = boolSV(sv_derived_from(sv, name));
+ XSRETURN(1);
+ }
}
XS(XS_UNIVERSAL_can)
}
if (pkg) {
- GV *gv = gv_fetchmethod_autoload(pkg, name, FALSE);
+ GV * const gv = gv_fetchmethod_autoload(pkg, name, FALSE);
if (gv && isGV(gv))
rv = sv_2mortal(newRV((SV*)GvCV(gv)));
}
gvp = pkg ? (GV**)hv_fetch(pkg,"VERSION",7,FALSE) : Null(GV**);
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
- SV *nsv = sv_newmortal();
+ SV * const nsv = sv_newmortal();
sv_setsv(nsv, sv);
sv = nsv;
if ( !sv_derived_from(sv, "version"))
if (undef) {
if (pkg) {
- const char *name = HvNAME_get(pkg);
+ const char * const name = HvNAME_get(pkg);
Perl_croak(aTHX_
"%s does not define $%s::VERSION--version check failed",
name, name);
if ( !sv_derived_from(req, "version")) {
/* req may very well be R/O, so create a new object */
- SV *nsv = sv_newmortal();
+ SV * const nsv = sv_newmortal();
sv_setsv(nsv, req);
req = nsv;
upg_version(req);
{
SV *vs = ST(1);
SV *rv;
- const char *classname;
-
- /* get the class if called as an object method */
- if ( sv_isobject(ST(0)) ) {
- classname = HvNAME(SvSTASH(SvRV(ST(0))));
- }
- else {
- classname = (char *)SvPV_nolen(ST(0));
- }
+ const char * const classname =
+ sv_isobject(ST(0)) /* get the class if called as an object method */
+ ? HvNAME(SvSTASH(SvRV(ST(0))))
+ : (char *)SvPV_nolen(ST(0));
if ( items == 1 ) {
/* no parameter provided */
if (items < 1)
Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
SP -= items;
- {
- SV * lobj = Nullsv;
-
- if (sv_derived_from(ST(0), "version")) {
- lobj = SvRV(ST(0));
- }
- else
- Perl_croak(aTHX_ "lobj is not of type version");
-
- {
- SV *rs;
- rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) );
- PUSHs(sv_2mortal(rs));
- }
-
- PUTBACK;
- return;
- }
+ if (sv_derived_from(ST(0), "version")) {
+ SV * const lobj = SvRV(ST(0));
+ SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) );
+ PUSHs(sv_2mortal(rs));
+ PUTBACK;
+ return;
+ }
+ else
+ Perl_croak(aTHX_ "lobj is not of type version");
}
XS(XS_version_noop)
if (items != 1)
Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)");
SP -= items;
- {
- SV * lobj = Nullsv;
-
- if (sv_derived_from(ST(0), "version"))
- lobj = ST(0);
- else
- Perl_croak(aTHX_ "lobj is not of type version");
-{
- if ( hv_exists((HV*)SvRV(lobj), "alpha", 5 ) )
- XSRETURN_YES;
- else
- XSRETURN_NO;
-}
+ if (sv_derived_from(ST(0), "version")) {
+ SV * const lobj = ST(0);
+ if ( hv_exists((HV*)SvRV(lobj), "alpha", 5 ) )
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
PUTBACK;
return;
}
+ else
+ Perl_croak(aTHX_ "lobj is not of type version");
}
XS(XS_version_qv)
SP -= items;
{
SV * ver = ST(0);
- if ( !SvVOK(ver) ) /* only need to do with if not already v-string */
- {
- SV *vs = sv_newmortal();
+ if ( !SvVOK(ver) ) { /* only need to do with if not already v-string */
+ SV * const vs = sv_newmortal();
char *version;
if ( SvNOK(ver) ) /* may get too much accuracy */
{
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
- {
- const SV *sv = ST(0);
- {
- if (SvUTF8(sv))
- XSRETURN_YES;
- else
- XSRETURN_NO;
- }
+ else {
+ const SV * const sv = ST(0);
+ if (SvUTF8(sv))
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
}
XSRETURN_EMPTY;
}
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
- {
- SV * sv = ST(0);
- {
- STRLEN len;
- const char *s = SvPV_const(sv,len);
- if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
- XSRETURN_YES;
- else
- XSRETURN_NO;
- }
- }
+ else {
+ SV * const sv = ST(0);
+ STRLEN len;
+ const char * const s = SvPV_const(sv,len);
+ if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
XSRETURN_EMPTY;
}
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
- {
- SV * sv = ST(0);
-
- sv_utf8_encode(sv);
- }
+ sv_utf8_encode(ST(0));
XSRETURN_EMPTY;
}
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
- {
- SV * sv = ST(0);
+ else {
+ SV * const sv = ST(0);
const bool RETVAL = sv_utf8_decode(sv);
ST(0) = boolSV(RETVAL);
sv_2mortal(ST(0));
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
- {
- SV * sv = ST(0);
+ else {
+ SV * const sv = ST(0);
STRLEN RETVAL;
dXSTARG;
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
- {
- SV * sv = ST(0);
+ else {
+ SV * const sv = ST(0);
const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
const bool RETVAL = sv_utf8_downgrade(sv, failok);
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
{
dXSARGS;
- SV *sv = SvRV(ST(0));
+ SV * const sv = SvRV(ST(0));
if (items == 1) {
if (SvREADONLY(sv))
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
{
dXSARGS;
- SV *sv = SvRV(ST(0));
+ SV * const sv = SvRV(ST(0));
if (items == 1)
XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
XS(XS_Internals_hv_clear_placehold)
{
dXSARGS;
- HV *hv = (HV *) SvRV(ST(0));
if (items != 1)
Perl_croak(aTHX_ "Usage: UNIVERSAL::hv_clear_placeholders(hv)");
- hv_clear_placeholders(hv);
- XSRETURN(0);
+ else {
+ HV * const hv = (HV *) SvRV(ST(0));
+ hv_clear_placeholders(hv);
+ XSRETURN(0);
+ }
}
XS(XS_Regexp_DESTROY)
bool details = FALSE;
if (items > 1) {
- SV **svp;
-
+ SV * const *svp;
for (svp = MARK + 2; svp <= SP; svp += 2) {
- SV **varp = svp;
- SV **valp = svp + 1;
+ SV * const * const varp = svp;
+ SV * const * const valp = svp + 1;
STRLEN klen;
- const char *key = SvPV_const(*varp, klen);
+ const char * const key = SvPV_const(*varp, klen);
switch (*key) {
case 'i':
if (gv && (io = GvIO(gv))) {
dTARGET;
- AV* av = PerlIO_get_layers(aTHX_ input ?
+ AV* const av = PerlIO_get_layers(aTHX_ input ?
IoIFP(io) : IoOFP(io));
I32 i;
- I32 last = av_len(av);
+ const I32 last = av_len(av);
I32 nitem = 0;
for (i = last; i >= 0; i -= 3) {
- SV **namsvp;
- SV **argsvp;
- SV **flgsvp;
- bool namok, argok, flgok;
-
- namsvp = av_fetch(av, i - 2, FALSE);
- argsvp = av_fetch(av, i - 1, FALSE);
- flgsvp = av_fetch(av, i, FALSE);
+ SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
+ SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
+ SV * const * const flgsvp = av_fetch(av, i, FALSE);
- namok = namsvp && *namsvp && SvPOK(*namsvp);
- argok = argsvp && *argsvp && SvPOK(*argsvp);
- flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
+ const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
+ const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
+ const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
if (details) {
XPUSHs(namok
XPUSHs(&PL_sv_undef);
nitem++;
if (flgok) {
- IV flags = SvIVX(*flgsvp);
+ const IV flags = SvIVX(*flgsvp);
if (flags & PERLIO_F_UTF8) {
XPUSHs(newSVpvn("utf8", 4));
{
dXSARGS;
if (SvROK(ST(0))) {
- const HV *hv = (HV *) SvRV(ST(0));
+ const HV * const hv = (HV *) SvRV(ST(0));
if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
if (HvREHASH(hv))
XSRETURN_YES;
return Nullch;
}
if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
- char *b = ninstr((char*)big,(char*)bigend,
+ char * const b = ninstr((char*)big,(char*)bigend,
(char*)little, (char*)little + littlelen);
if (!b && SvTAIL(littlestr)) { /* Automatically multiline! */
}
{ /* Do actual FBM. */
- register const unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
+ register const unsigned char * const table = little + littlelen + FBM_TABLE_OFFSET;
register const unsigned char *oldlittle;
if (littlelen > (STRLEN)(bigend - big))
SV *
Perl_vmess(pTHX_ const char *pat, va_list *args)
{
- SV *sv = mess_alloc();
+ SV * const sv = mess_alloc();
static const char dgd[] = " during global destruction.\n";
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (val == NULL) {
(void)unsetenv(nam);
} else {
- int nlen = strlen(nam);
- int vlen = strlen(val);
- char *new_env =
+ const int nlen = strlen(nam);
+ const int vlen = strlen(val);
+ char * const new_env =
(char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
}
# else /* ! HAS_UNSETENV */
char *new_env;
- int nlen = strlen(nam), vlen;
+ const int nlen = strlen(nam);
+ int vlen;
if (!val) {
val = "";
}
#ifdef PERL_USES_PL_PIDSTATUS
{
if (pid > 0) {
- SV** svp;
-
/* The keys in PL_pidstatus are now the raw 4 (or 8) bytes of the
pid, rather than a string form. */
-
- svp = hv_fetch(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),FALSE);
+ SV * const * const svp = hv_fetch(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),FALSE);
if (svp && *svp != &PL_sv_undef) {
*statusp = SvIVX(*svp);
(void)hv_delete(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),
hv_iterinit(PL_pidstatus);
if ((entry = hv_iternext(PL_pidstatus))) {
- SV *sv = hv_iterval(PL_pidstatus,entry);
+ SV * const sv = hv_iterval(PL_pidstatus,entry);
I32 len;
const char *spid = hv_iterkey(entry,&len);
#endif
{
/* Needs work for PerlIO ! */
- FILE *f = PerlIO_findFILE(ptr);
+ FILE * const f = PerlIO_findFILE(ptr);
I32 result = pclose(f);
PerlIO_releaseFILE(ptr,f);
return result;
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
/* Needs work for PerlIO ! */
- FILE *f = PerlIO_findFILE(ptr);
+ FILE * const f = PerlIO_findFILE(ptr);
I32 result = djgpp_pclose(f);
result = (result << 8) & 0xff00;
PerlIO_releaseFILE(ptr,f);
Perl_repeatcpy(pTHX_ register char *to, register const char *from, I32 len, register I32 count)
{
register I32 todo;
- register const char *frombase = from;
+ register const char * const frombase = from;
if (len == 1) {
register const char c = *from;
char *fb = strrchr(b,'/');
Stat_t tmpstatbuf1;
Stat_t tmpstatbuf2;
- SV *tmpsv = sv_newmortal();
+ SV * const tmpsv = sv_newmortal();
if (fa)
fa++;
# ifdef ALWAYS_DEFTYPES
len = strlen(scriptname);
if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
- int hasdir, idx = 0, deftypes = 1;
+ int idx = 0, deftypes = 1;
bool seen_dot = 1;
- hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+ const int hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch);
# else
if (dosearch) {
- int hasdir, idx = 0, deftypes = 1;
+ int idx = 0, deftypes = 1;
bool seen_dot = 1;
- hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+ const int hasdir = (strpbrk(scriptname,":[</") != Nullch);
# endif
/* The first time through, just add SEARCH_EXTS to whatever we
* already have, so we can check for default file types. */
projects / p5sagit/p5-mst-13.2.git / commitdiff