#endif
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
if (where) {
- /*SUPPRESS 701*/
PerlMem_free(where);
}
}
register I32 tmp;
top2:
- /*SUPPRESS 560*/
if ((tmp = table[*s])) {
if ((s += tmp) < bigend)
goto top2;
else {
#ifdef USE_SFIO
/* SFIO can really mess with your errno */
- int e = errno;
+ const int e = errno;
#endif
- PerlIO *serr = Perl_error_log;
+ PerlIO * const serr = Perl_error_log;
PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
(void)PerlIO_flush(serr);
Perl_vwarn(pTHX_ const char* pat, va_list *args)
{
dVAR;
- const char *message;
- HV *stash;
- GV *gv;
- CV *cv;
- SV *msv;
STRLEN msglen;
- I32 utf8 = 0;
-
- msv = vmess(pat, args);
- utf8 = SvUTF8(msv);
- message = SvPV_const(msv, msglen);
+ SV * const msv = vmess(pat, args);
+ const I32 utf8 = SvUTF8(msv);
+ const char * const message = SvPV_const(msv, msglen);
if (PL_warnhook) {
/* sv_2cv might call Perl_warn() */
- SV *oldwarnhook = PL_warnhook;
+ SV * const oldwarnhook = PL_warnhook;
+ CV * cv;
+ HV * stash;
+ GV * gv;
+
ENTER;
SAVESPTR(PL_warnhook);
PL_warnhook = Nullsv;
I32 max;
char **tmpenv;
- /*SUPPRESS 530*/
for (max = i; environ[max]; max++) ;
tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
for (j=0; j<max; j++) { /* copy environment */
setenv(nam, val, 1);
# else
char *new_env;
- int nlen = strlen(nam), vlen;
+ const int nlen = strlen(nam);
+ int vlen;
if (!val) {
val = "";
}
I32
Perl_setenv_getix(pTHX_ const char *nam)
{
- register I32 i, len = strlen(nam);
+ register I32 i;
+ const register I32 len = strlen(nam);
for (i = 0; environ[i]; i++) {
if (
PerlProc__exit(1);
}
#endif /* defined OS2 */
- /*SUPPRESS 560*/
if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), PerlProc_getpid());
#endif /* !DOSISH || OS2 || WIN32 || NETWARE */
void
-/*SUPPRESS 590*/
Perl_pidgone(pTHX_ Pid_t pid, int status)
{
register SV *sv;
int extidx = 0, i = 0;
const char *curext = Nullch;
#else
- (void)search_ext;
+ PERL_UNUSED_ARG(search_ext);
# define MAX_EXT_LEN 0
#endif
AV *av = newAV();
SV* hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+#ifndef NODEFAULT_SHAREKEYS
+ HvSHAREKEYS_on(hv); /* key-sharing on by default */
+#endif
if (*s == 'v') {
s++; /* get past 'v' */
if ( sv_derived_from(ver,"version") ) /* can just copy directly */
{
I32 key;
- AV *av = newAV();
+ AV * const av = newAV();
AV *sav;
/* This will get reblessed later if a derived class*/
- SV* hv = newSVrv(rv, "version");
+ SV* const hv = newSVrv(rv, "version");
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+#ifndef NODEFAULT_SHAREKEYS
+ HvSHAREKEYS_on(hv); /* key-sharing on by default */
+#endif
if ( SvROK(ver) )
ver = SvRV(ver);
if ( hv_exists((HV*)ver, "width", 5 ) )
{
- I32 width = SvIV(*hv_fetch((HV*)ver, "width", 5, FALSE));
+ const I32 width = SvIV(*hv_fetch((HV*)ver, "width", 5, FALSE));
hv_store((HV *)hv, "width", 5, newSViv(width), 0);
}
I32 i, len, digit;
int width;
bool alpha = FALSE;
- SV *sv = newSV(0);
+ SV * const sv = newSV(0);
AV *av;
if ( SvROK(vs) )
vs = SvRV(vs);
/* attempt to retrieve the version array */
if ( !(av = (AV *)*hv_fetch((HV*)vs, "version", 7, FALSE) ) ) {
- Perl_sv_catpv(aTHX_ sv,"0");
+ sv_catpvn(sv,"0",1);
return sv;
}
{
digit = SvIV(*av_fetch(av, i, 0));
if ( width < 3 ) {
- int denom = (int)pow(10,(3-width));
- div_t term = div((int)PERL_ABS(digit),denom);
+ const int denom = (int)pow(10,(3-width));
+ const div_t term = div((int)PERL_ABS(digit),denom);
Perl_sv_catpvf(aTHX_ sv,"%0*d_%d", width, term.quot, term.rem);
}
else {
void
Perl_sv_nosharing(pTHX_ SV *sv)
{
- (void)sv;
+ PERL_UNUSED_ARG(sv);
}
/*
void
Perl_sv_nolocking(pTHX_ SV *sv)
{
- (void)sv;
+ PERL_UNUSED_ARG(sv);
}
void
Perl_sv_nounlocking(pTHX_ SV *sv)
{
- (void)sv;
+ PERL_UNUSED_ARG(sv);
}
U32
return myseed;
}
+#ifdef USE_ITHREADS
+bool
+Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv)
+{
+ const char * const stashpv = CopSTASHPV(c);
+ const char * const name = HvNAME_get(hv);
+
+ if (stashpv == name)
+ return TRUE;
+ if (stashpv && name)
+ if (strEQ(stashpv, name))
+ return TRUE;
+ return FALSE;
+}
+#endif
+
+
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars *