X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=4b31e4bb56791e3ac55db92228fbc195bc25c2b2;hb=a28509cc00517ad2ad1f6e022f1be6ab8f1ad18e;hp=05b9fc67c0082fe3fd238e41a8b1252d910ff4a1;hpb=075abff3feb0c6965ba49108266b27bec1bd4ae6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 05b9fc6..4b31e4b 100644 --- a/mg.c +++ b/mg.c @@ -81,7 +81,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) { MGS* mgs; assert(SvMAGICAL(sv)); -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE /* Turning READONLY off for a copy-on-write scalar is a bad idea. */ if (SvIsCOW(sv)) sv_force_normal(sv); @@ -263,11 +263,11 @@ Perl_mg_length(pTHX_ SV *sv) } if (DO_UTF8(sv)) { - U8 *s = (U8*)SvPV(sv, len); + const U8 *s = (U8*)SvPV_const(sv, len); len = Perl_utf8_length(aTHX_ s, s + len); } else - (void)SvPV(sv, len); + (void)SvPV_const(sv, len); return len; } @@ -493,12 +493,13 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) i = t1 - s1; getlen: if (i > 0 && RX_MATCH_UTF8(rx)) { - char *s = rx->subbeg + s1; - char *send = rx->subbeg + t1; + const char * const s = rx->subbeg + s1; + const U8 *ep; + STRLEN el; i = t1 - s1; - if (is_utf8_string((U8*)s, i)) - i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send); + if (is_utf8_string_loclen((U8*)s, i, &ep, &el)) + i = el; } if (i < 0) Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i); @@ -555,8 +556,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) } magic_get(sv,mg); if (!SvPOK(sv) && SvNIOK(sv)) { - STRLEN n_a; - sv_2pv(sv, &n_a); + sv_2pv(sv, 0); } if (SvPOK(sv)) return SvCUR(sv); @@ -951,12 +951,12 @@ int Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) { dVAR; - register char *s; - char *ptr; + const char *s; + const char *ptr; STRLEN len, klen; - s = SvPV(sv,len); - ptr = MgPV(mg,klen); + s = SvPV_const(sv,len); + ptr = MgPV_const(mg,klen); my_setenv(ptr, s); #ifdef DYNAMIC_ENV_FETCH @@ -965,7 +965,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) if (!len) { SV **valp; if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE))) - s = SvPV(*valp, len); + s = SvPV_const(*valp, len); } #endif @@ -1001,7 +1001,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) } #endif /* VMS */ if (s && klen == 4 && strEQ(ptr,"PATH")) { - char *strend = s + len; + const char *strend = s + len; while (s < strend) { char tmpbuf[256]; @@ -1027,9 +1027,8 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) 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; } @@ -1041,13 +1040,12 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg) #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 @@ -1099,7 +1097,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) 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 @@ -1107,9 +1105,8 @@ int 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]); @@ -1140,8 +1137,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) * 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; @@ -1292,7 +1288,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) 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; @@ -1633,12 +1629,11 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) 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) @@ -1770,7 +1765,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) { 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; @@ -1791,7 +1786,7 @@ int 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); @@ -2070,7 +2065,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) 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 @@ -2172,7 +2167,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) 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) ; @@ -2389,7 +2384,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case ')': #ifdef HAS_SETGROUPS { - const char *p = SvPV(sv, len); + const char *p = SvPV_const(sv, len); Groups_t gary[NGROUPS]; while (isSPACE(*p)) @@ -2446,7 +2441,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) * 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) @@ -2468,7 +2463,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #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); } @@ -2642,7 +2637,7 @@ restore_magic(pTHX_ const void *p) if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE /* While magic was saved (and off) sv_setsv may well have seen this SV as a prime candidate for COW. */ if (SvIsCOW(sv))