i = t1 - s1;
getlen:
if (i > 0 && RX_MATCH_UTF8(rx)) {
- char *s = rx->subbeg + s1;
+ const char * const s = rx->subbeg + s1;
const U8 *ep;
STRLEN el;
return 0;
}
+#define SvRTRIM(sv) STMT_START { \
+ STRLEN len = SvCUR(sv); \
+ while (len > 0 && isSPACE(SvPVX(sv)[len-1])) \
+ --len; \
+ SvCUR_set(sv, len); \
+} STMT_END
+
int
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
{
#endif
#endif
#endif
+ SvRTRIM(sv);
SvNOK_on(sv); /* what a wonderful hack! */
}
else if (strEQ(mg->mg_ptr+1, "NCODING"))
if (PL_ors_sv)
sv_copypv(sv, PL_ors_sv);
break;
- case '#':
- sv_setpv(sv,PL_ofmt);
- break;
case '!':
#ifdef VMS
sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
errno = saveerrno;
}
#endif
+ SvRTRIM(sv);
SvNOK_on(sv); /* what a wonderful hack! */
break;
case '<':
Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
{
dVAR;
- register char *s;
+ const char *s;
const char *ptr;
STRLEN len, klen;
- s = SvPV(sv,len);
+ s = SvPV_const(sv,len);
ptr = MgPV_const(mg,klen);
my_setenv(ptr, s);
if (!len) {
SV **valp;
if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
- s = SvPV(*valp, len);
+ s = SvPV_const(*valp, len);
}
#endif
}
#endif /* VMS */
if (s && klen == 4 && strEQ(ptr,"PATH")) {
- char *strend = s + len;
+ const char *strend = s + len;
while (s < strend) {
char tmpbuf[256];
int
Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
{
- STRLEN n_a;
(void)sv;
- my_setenv(MgPV(mg,n_a),Nullch);
+ my_setenv(MgPV_nolen_const(mg),Nullch);
return 0;
}
#else
if (PL_localizing) {
HE* entry;
- STRLEN n_a;
magic_clear_all_env(sv,mg);
hv_iterinit((HV*)sv);
while ((entry = hv_iternext((HV*)sv))) {
I32 keylen;
my_setenv(hv_iterkey(entry, &keylen),
- SvPV(hv_iterval((HV*)sv, entry), n_a));
+ SvPV_nolen_const(hv_iterval((HV*)sv, entry)));
}
}
#endif
static void
restore_sigmask(pTHX_ SV *save_sv)
{
- sigset_t *ossetp = (sigset_t *) SvPV_nolen( save_sv );
+ const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
(void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
}
#endif
Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
{
I32 i;
- STRLEN n_a;
/* Are we fetching a signal entry? */
- i = whichsig(MgPV(mg,n_a));
+ i = whichsig(MgPV_nolen_const(mg));
if (i > 0) {
if(PL_psig_ptr[i])
sv_setsv(sv,PL_psig_ptr[i]);
* refactoring might be in order.
*/
dVAR;
- STRLEN n_a;
- register const char *s = MgPV(mg,n_a);
+ register const char *s = MgPV_nolen_const(mg);
(void)sv;
if (*s == '_') {
SV** svp = 0;
SV* save_sv;
#endif
- register const char *s = MgPV(mg,len);
+ register const char *s = MgPV_const(mg,len);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
I32 i;
GV* gv;
SV** svp;
- STRLEN n_a;
gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
- atoi(MgPV(mg,n_a)), FALSE);
+ atoi(MgPV_nolen_const(mg)), FALSE);
if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) {
/* set or clear breakpoint in the relevant control op */
if (i)
int
Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg)
{
- sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + PL_curcop->cop_arybase);
+ AV *obj = (AV*)mg->mg_obj;
+ if (obj) {
+ sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
+ } else {
+ SvOK_off(sv);
+ }
return 0;
}
int
Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
{
- av_fill((AV*)mg->mg_obj, SvIV(sv) - PL_curcop->cop_arybase);
+ AV *obj = (AV*)mg->mg_obj;
+ if (obj) {
+ av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
+ } else {
+ if (ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
+ "Attempt to set length of freed array");
+ }
+ return 0;
+}
+
+int
+Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
+{
+ PERL_UNUSED_ARG(sv);
+ /* during global destruction, mg_obj may already have been freed */
+ if (PL_in_clean_all)
+ return 0;
+
+ mg = mg_find (mg->mg_obj, PERL_MAGIC_arylen);
+
+ if (mg) {
+ /* arylen scalar holds a pointer back to the array, but doesn't own a
+ reference. Hence the we (the array) are about to go away with it
+ still pointing at us. Clear its pointer, else it would be pointing
+ at free memory. See the comment in sv_magic about reference loops,
+ and why it can't own a reference to us. */
+ mg->mg_obj = 0;
+ }
return 0;
}
{
STRLEN len;
SV * const lsv = LvTARG(sv);
- const char * const tmps = SvPV(lsv,len);
+ const char * const tmps = SvPV_const(lsv,len);
I32 offs = LvTARGOFF(sv);
I32 rem = LvTARGLEN(sv);
(void)mg;
Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
{
STRLEN len;
- char *tmps = SvPV(sv, len);
+ const char *tmps = SvPV_const(sv, len);
SV * const lsv = LvTARG(sv);
I32 lvoff = LvTARGOFF(sv);
I32 lvlen = LvTARGLEN(sv);
case '\004': /* ^D */
#ifdef DEBUGGING
- s = SvPV_nolen(sv);
+ s = SvPV_nolen_const(sv);
PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
DEBUG_x(dump_all());
#else
STRLEN len, i;
int accumulate = 0 ;
int any_fatals = 0 ;
- const char * const ptr = (char*)SvPV(sv, len) ;
+ const char * const ptr = SvPV_const(sv, len) ;
for (i = 0 ; i < len ; ++i) {
accumulate |= ptr[i] ;
any_fatals |= (ptr[i] & 0xAA) ;
PL_ofs_sv = Nullsv;
}
break;
- case '#':
- if (PL_ofmt)
- Safefree(PL_ofmt);
- PL_ofmt = savesvpv(sv);
- break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case ')':
#ifdef HAS_SETGROUPS
{
- const char *p = SvPV(sv, len);
+ const char *p = SvPV_const(sv, len);
Groups_t gary[NGROUPS];
while (isSPACE(*p))
* show a string from the process struct and provide
* the setproctitle() routine to manipulate that. */
{
- s = SvPV(sv, len);
+ s = SvPV_const(sv, len);
# if __FreeBSD_version > 410001
/* The leading "-" removes the "perl: " prefix,
* but not the "(perl) suffix from the ps(1)
#if defined(__hpux) && defined(PSTAT_SETCMD)
{
union pstun un;
- s = SvPV(sv, len);
+ s = SvPV_const(sv, len);
un.pst_command = (char *)s;
pstat(PSTAT_SETCMD, un, len, 0, 0);
}